a bit of finalization

src/Patch.hs

@@ -3,10 +3,8 @@ module Patch
   , pprPatchWarn
   ) where
 
-import qualified Data.ByteString as B
 import Data.Maybe (catMaybes)
 import qualified Data.Vector as V
-import Format
 import Merge
 import Types
 
@@ -15,13 +13,6 @@ data PatchWarn
   | HunkFailed Hunk (Int, Int)
   deriving (Show)
 
-data PatchOpts =
-  PatchOpts
-    { scanRange :: Int
-    , minContext :: Int
-    , mergeOpts :: MergeOpts
-    }
-
 data PatchState =
   PatchState
     { input :: TV
@@ -50,9 +41,17 @@ patchToks ::
   -> Int
   -> MergeOpts
   -> (TV, [Hunk], [PatchWarn])
-patchToks toks hunks revPatch scan ctxt mopt =
+patchToks toks hunks' revPatch scan ctxt mopt =
   go hunks $ PatchState toks [] [] 0 0 0 0
   where
+    hunks
+      | revPatch = map revHunk hunks'
+      | otherwise = hunks'
+    revHunk ((o, n), diff) = ((n, o), map revDiff diff)
+    revDiff (Add, t) = (Remove, t)
+    revDiff (Remove, t) = (Add, t)
+    revDiff (Keep, t) = (Keep, t)
+    revDiff _ = error "cannot reverse conflict diff"
     go [] ps =
       ( V.concat (output ps ++ [V.drop (inOff ps) (input ps)])
       , [rej | HunkFailed rej _ <- warns ps]
@@ -106,12 +105,13 @@ patchHunkClean ps ((fromPos, toPos), diff) mopts
         { output = output ps ++ [skipped, V.fromList repl]
         , inOff = expInOff + matchLen
         , patchInOff = fromPos + matchLen
-        , outOff = expOutOff + length repl
-        , patchOutOff = toPos + length repl
+        , outOff = expOutOff + replLen
+        , patchOutOff = toPos + replLen
         }
   | otherwise = Nothing
   where
     matchLen = diffMatchLen diff
+    replLen = diffReplLen diff
     advance = fromPos - patchInOff ps
     expInOff = advance + inOff ps
     expOutOff = advance + outOff ps
@@ -134,6 +134,14 @@ diffMatchLen = sum . map (off . fst)
     off Original = 1
     off _ = 0
 
+diffReplLen :: Diff -> Int
+diffReplLen = sum . map (off . fst)
+  where
+    off Keep = 1
+    off Add = 1
+    off Original = 1
+    off _ = 0 -- tricky: the conflicts do not actually add to the diff counters
+
 diffOffChange :: Diff -> Int
 diffOffChange = sum . map (off . fst)
   where
@@ -141,27 +149,58 @@ diffOffChange = sum . map (off . fst)
     off Remove = -1
     off _ = 0
 
+markToks :: MergeOpts -> Op -> Op -> [Tok]
+markToks mopts x' y' = map (\s -> (True, s)) $ go x' y'
+  where
+    unmarked :: Op -> Bool
+    unmarked Keep = True
+    unmarked Add = True
+    unmarked Remove = True
+    unmarked _ = False
+    go :: Op -> Op -> [BS]
+    go x y
+      | x == y = []
+      | unmarked x = goUnmarked y
+      | x == MineChanged
+      , y /= Original = mergeYourSepStr mopts : go YourChanged y
+      | x == MineChanged = mergeMineSepStr mopts : go Original y
+      | x == Original = mergeYourSepStr mopts : go YourChanged y
+      | x == YourChanged = mergeCEndStr mopts : goUnmarked y
+      | otherwise = error "internal error in markToks"
+    goUnmarked :: Op -> [BS]
+    goUnmarked y
+      | unmarked y = []
+      | otherwise = mergeCStartStr mopts : go MineChanged y
+
 matchDiff :: MergeOpts -> [Tok] -> Diff -> Maybe [Tok]
-matchDiff mopt ts ds
-  | null ts
-  , null ds = return []
-  | ((op, tok):ds') <- ds
-  , op == Add {-, MineChanged, YourChanged -- TODO special treatment needed -}
-   = (tok :) <$> matchDiff mopt ts ds'
-  | (intok:ts') <- ts
-  , ((op, tok):ds') <- ds
-  , op == Keep {-, Original -- TODO special treatment needed-}
-  , tokCmp' mopt intok tok =
-    (:)
-      (if mergeKeepWhitespace mopt && not (fst intok)
-         then intok
-         else tok) <$>
-    matchDiff mopt ts' ds'
-  | (intok:ts') <- ts
-  , ((op, tok):ds') <- ds
-  , op == Remove
-  , tokCmp' mopt intok tok = matchDiff mopt ts' ds'
-  | otherwise = Nothing
+matchDiff mopt = go Keep
+  where
+    withMark :: Op -> Op -> [Tok] -> ([Tok] -> [Tok])
+    withMark prev op toks = (++) (markToks mopt prev op ++ toks)
+    go :: Op -> [Tok] -> Diff -> Maybe [Tok]
+    go prev ts ds
+      | null ts
+      , null ds = return $ markToks mopt prev Keep
+      | ((op, tok):ds') <- ds
+      , op == Add || op == MineChanged || op == YourChanged =
+        withMark prev op [tok] <$> go op ts ds'
+      | (intok:ts') <- ts
+      , ((op, tok):ds') <- ds
+      , op == Keep || op == Original
+      , tokCmp' mopt intok tok =
+        withMark
+          prev
+          op
+          [ if mergeKeepWhitespace mopt && not (fst intok)
+              then intok
+              else tok
+          ] <$>
+        go op ts' ds'
+      | (intok:ts') <- ts
+      , ((op, tok):ds') <- ds
+      , op == Remove
+      , tokCmp' mopt intok tok = withMark prev op [] <$> go op ts' ds'
+      | otherwise = Nothing
 
 tokCmp' :: MergeOpts -> Tok -> Tok -> Bool
 tokCmp' MergeOpts {mergeForceWhitespace = x} = tokCmp x