{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Darcs.Patch.Split
( Splitter(..)
, rawSplitter
, noSplitter
, primSplitter
, reversePrimSplitter
) where
import Prelude ()
import Darcs.Prelude
import Data.List ( intersperse )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Show ( showPatch, ShowPatch(..) )
import Darcs.Patch.Invert( Invert(..), invertFL )
import Darcs.Patch.Prim ( PrimPatch, canonize, canonizeFL, primFromHunk )
import Darcs.Patch.ReadMonads ( parseStrictly )
import Darcs.Patch.Read ()
import Darcs.Patch.Show ( ShowPatchFor(ForDisplay) )
import Darcs.Patch.Viewing ()
import Darcs.Util.Printer ( renderPS )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
data Splitter p = Splitter
{ Splitter p
-> forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter :: forall wX wY. p wX wY
-> Maybe (B.ByteString, B.ByteString -> Maybe (FL p wX wY))
, Splitter p -> forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
}
withEditedHead :: Invert p => p wX wY -> p wX wZ -> FL p wX wY
withEditedHead :: p wX wY -> p wX wZ -> FL p wX wY
withEditedHead p :: p wX wY
p res :: p wX wZ
res = p wX wZ
res p wX wZ -> FL p wZ wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wX wZ -> p wZ wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert p wX wZ
res p wZ wX -> FL p wX wY -> FL p wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wX wY
p p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
rawSplitter :: (ShowPatch p, ReadPatch p, Invert p) => Splitter p
rawSplitter :: Splitter p
rawSplitter = Splitter :: forall (p :: * -> * -> *).
(forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY)))
-> (forall wX wY. FL p wX wY -> FL p wX wY) -> Splitter p
Splitter
{ applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = \p :: p wX wY
p ->
(ByteString, ByteString -> Maybe (FL p wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a. a -> Maybe a
Just (Doc -> ByteString
renderPS (Doc -> ByteString) -> (p wX wY -> Doc) -> p wX wY -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowPatchFor -> p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay (p wX wY -> ByteString) -> p wX wY -> ByteString
forall a b. (a -> b) -> a -> b
$ p wX wY
p
,\str :: ByteString
str -> case SM (Sealed (p wX))
-> ByteString -> Maybe (Sealed (p wX), ByteString)
forall a. SM a -> ByteString -> Maybe (a, ByteString)
parseStrictly SM (Sealed (p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' ByteString
str of
Just (Sealed res :: p wX wX
res, _) -> FL p wX wY -> Maybe (FL p wX wY)
forall a. a -> Maybe a
Just (p wX wY -> p wX wX -> FL p wX wY
forall (p :: * -> * -> *) wX wY wZ.
Invert p =>
p wX wY -> p wX wZ -> FL p wX wY
withEditedHead p wX wY
p p wX wX
res)
_ -> Maybe (FL p wX wY)
forall a. Maybe a
Nothing)
, canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = forall a. a -> a
forall wX wY. FL p wX wY -> FL p wX wY
id
}
noSplitter :: Splitter p
noSplitter :: Splitter p
noSplitter = Splitter :: forall (p :: * -> * -> *).
(forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY)))
-> (forall wX wY. FL p wX wY -> FL p wX wY) -> Splitter p
Splitter { applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
-> p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a b. a -> b -> a
const Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall a. Maybe a
Nothing, canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = forall a. a -> a
forall wX wY. FL p wX wY -> FL p wX wY
id }
doPrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
-> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doPrimSplit :: DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit da :: DiffAlgorithm
da = DiffAlgorithm
-> Bool
-> [ByteString]
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall (prim :: * -> * -> *) (p :: * -> * -> *) wX wY.
(PrimPatch prim, IsHunk p) =>
DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ DiffAlgorithm
da Bool
True [ByteString]
explanation
where
explanation :: [ByteString]
explanation =
(String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack
[ "Interactive hunk edit:"
, " - Edit the section marked 'AFTER'"
, " - Arbitrary editing is supported"
, " - This will only affect the patch, not your working tree"
, " - Hints:"
, " - To split added text, delete the part you want to postpone"
, " - To split removed text, copy back the part you want to retain"
, ""
]
doPrimSplit_ :: (PrimPatch prim, IsHunk p)
=> D.DiffAlgorithm
-> Bool
-> [B.ByteString]
-> p wX wY
-> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ :: DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ da :: DiffAlgorithm
da edit_before_part :: Bool
edit_before_part helptext :: [ByteString]
helptext (p wX wY -> Maybe (FileHunk wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk -> Just (FileHunk fn :: FileName
fn n :: Int
n before :: [ByteString]
before after :: [ByteString]
after))
= (ByteString, ByteString -> Maybe (FL prim wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall a. a -> Maybe a
Just ([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse (String -> ByteString
BC.pack "\n") ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ByteString]
helptext
, [String -> ByteString
mkSep " BEFORE (reference) =========================="]
, [ByteString]
before
, [String -> ByteString
mkSep "=== AFTER (edit) ============================="]
, [ByteString]
after
, [String -> ByteString
mkSep "=== (edit above) ============================="]
],
\bs :: ByteString
bs -> do let ls :: [ByteString]
ls = Char -> ByteString -> [ByteString]
BC.split '\n' ByteString
bs
(_, ls2 :: [ByteString]
ls2) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls
(before' :: [ByteString]
before', ls3 :: [ByteString]
ls3) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls2
(after' :: [ByteString]
after', _) <- [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep [ByteString]
ls3
FL prim wX wY -> Maybe (FL prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL prim wX wY -> Maybe (FL prim wX wY))
-> FL prim wX wY -> Maybe (FL prim wX wY)
forall a b. (a -> b) -> a -> b
$
if Bool
edit_before_part
then [ByteString] -> [ByteString] -> FL prim wX Any
forall (prim :: * -> * -> *) wA wB.
PrimPatch prim =>
[ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before [ByteString]
before' FL prim wX Any -> FL prim Any wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any Any
forall (prim :: * -> * -> *) wA wB.
PrimPatch prim =>
[ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before' [ByteString]
after' FL prim Any Any -> FL prim Any wY -> FL prim Any wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any wY
forall (prim :: * -> * -> *) wA wB.
PrimPatch prim =>
[ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
after' [ByteString]
after
else [ByteString] -> [ByteString] -> FL prim wX Any
forall (prim :: * -> * -> *) wA wB.
PrimPatch prim =>
[ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
before [ByteString]
after' FL prim wX Any -> FL prim Any wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ [ByteString] -> [ByteString] -> FL prim Any wY
forall (prim :: * -> * -> *) wA wB.
PrimPatch prim =>
[ByteString] -> [ByteString] -> FL prim wA wB
hunk [ByteString]
after' [ByteString]
after)
where sep :: ByteString
sep = String -> ByteString
BC.pack "=========================="
hunk :: PrimPatch prim => [B.ByteString] -> [B.ByteString] -> FL prim wA wB
hunk :: [ByteString] -> [ByteString] -> FL prim wA wB
hunk b :: [ByteString]
b a :: [ByteString]
a = DiffAlgorithm -> prim wA wB -> FL prim wA wB
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> prim wX wY -> FL prim wX wY
canonize DiffAlgorithm
da (FileHunk wA wB -> prim wA wB
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
FileHunk wX wY -> prim wX wY
primFromHunk (FileName -> Int -> [ByteString] -> [ByteString] -> FileHunk wA wB
forall wX wY.
FileName -> Int -> [ByteString] -> [ByteString] -> FileHunk wX wY
FileHunk FileName
fn Int
n [ByteString]
b [ByteString]
a))
mkSep :: String -> ByteString
mkSep s :: String
s = ByteString -> ByteString -> ByteString
BC.append ByteString
sep (String -> ByteString
BC.pack String
s)
breakSep :: [ByteString] -> Maybe ([ByteString], [ByteString])
breakSep xs :: [ByteString]
xs = case (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString
sep ByteString -> ByteString -> Bool
`BC.isPrefixOf`) [ByteString]
xs of
(_, []) -> Maybe ([ByteString], [ByteString])
forall a. Maybe a
Nothing
(ys :: [ByteString]
ys, _:zs :: [ByteString]
zs) -> ([ByteString], [ByteString]) -> Maybe ([ByteString], [ByteString])
forall a. a -> Maybe a
Just ([ByteString]
ys, [ByteString]
zs)
doPrimSplit_ _ _ _ _ = Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall a. Maybe a
Nothing
primSplitter :: PrimPatch p => D.DiffAlgorithm -> Splitter p
primSplitter :: DiffAlgorithm -> Splitter p
primSplitter da :: DiffAlgorithm
da = Splitter :: forall (p :: * -> * -> *).
(forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY)))
-> (forall wX wY. FL p wX wY -> FL p wX wY) -> Splitter p
Splitter { applySplitter :: forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
applySplitter = DiffAlgorithm
-> p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY))
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit DiffAlgorithm
da
, canonizeSplit :: forall wX wY. FL p wX wY -> FL p wX wY
canonizeSplit = DiffAlgorithm -> FL p wX wY -> FL p wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da }
doReversePrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
-> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit :: DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit da :: DiffAlgorithm
da prim :: prim wX wY
prim = do
(text :: ByteString
text, parser :: ByteString -> Maybe (FL prim wY wX)
parser) <- DiffAlgorithm
-> Bool
-> [ByteString]
-> prim wY wX
-> Maybe (ByteString, ByteString -> Maybe (FL prim wY wX))
forall (prim :: * -> * -> *) (p :: * -> * -> *) wX wY.
(PrimPatch prim, IsHunk p) =>
DiffAlgorithm
-> Bool
-> [ByteString]
-> p wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doPrimSplit_ DiffAlgorithm
da Bool
False [ByteString]
reverseExplanation (prim wX wY -> prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert prim wX wY
prim)
let parser' :: ByteString -> Maybe (FL prim wX wY)
parser' p :: ByteString
p = do
FL prim wY wX
patch <- ByteString -> Maybe (FL prim wY wX)
parser ByteString
p
FL prim wX wY -> Maybe (FL prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL prim wX wY -> Maybe (FL prim wX wY))
-> (RL prim wX wY -> FL prim wX wY)
-> RL prim wX wY
-> Maybe (FL prim wX wY)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RL prim wX wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (RL prim wX wY -> Maybe (FL prim wX wY))
-> RL prim wX wY -> Maybe (FL prim wX wY)
forall a b. (a -> b) -> a -> b
$ FL prim wY wX -> RL prim wX wY
forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL prim wY wX
patch
(ByteString, ByteString -> Maybe (FL prim wX wY))
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
text, ByteString -> Maybe (FL prim wX wY)
parser')
where
reverseExplanation :: [ByteString]
reverseExplanation =
(String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack
[ "Interactive hunk edit:"
, " - Edit the section marked 'AFTER' (representing the state to which you'll revert)"
, " - Arbitrary editing is supported"
, " - Your working tree will be returned to the 'AFTER' state"
, " - Do not touch the 'BEFORE' section"
, " - Hints:"
, " - To revert only a part of a text addition, delete the part you want to get rid of"
, " - To revert only a part of a removal, copy back the part you want to retain"
, ""
]
reversePrimSplitter :: PrimPatch prim => D.DiffAlgorithm -> Splitter prim
reversePrimSplitter :: DiffAlgorithm -> Splitter prim
reversePrimSplitter da :: DiffAlgorithm
da = Splitter :: forall (p :: * -> * -> *).
(forall wX wY.
p wX wY -> Maybe (ByteString, ByteString -> Maybe (FL p wX wY)))
-> (forall wX wY. FL p wX wY -> FL p wX wY) -> Splitter p
Splitter { applySplitter :: forall wX wY.
prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
applySplitter = DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
DiffAlgorithm
-> prim wX wY
-> Maybe (ByteString, ByteString -> Maybe (FL prim wX wY))
doReversePrimSplit DiffAlgorithm
da
, canonizeSplit :: forall wX wY. FL prim wX wY -> FL prim wX wY
canonizeSplit = DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
canonizeFL DiffAlgorithm
da }