merging merges

adiff.cabal

@@ -46,6 +46,7 @@ executable adiff
   other-modules: Diff,
                  Diff3,
                  Format,
+                 Hunks,
                  Merge,
                  Patch,
                  Redfa,

src/Diff.hs

@@ -1,8 +1,5 @@
 module Diff
-  ( Tok
-  , Op
-  , diffToks
-  , hunks
+  ( diffToks
   ) where
 
 import Control.Monad
@@ -259,29 +256,3 @@ diffToks' de@DiffEnv {deS = s, deE = e, deA = a, deB = b, deTrans = trans} =
       | otherwise =
         diffToks' de {deE = mid, deVE = vecEmid, deB = opt} ++
         diffToks' de {deS = mid, deVS = vecSmid, deA = opt}
-
-hunks :: Int -> Diff -> [Hunk]
-hunks ctxt d =
-  map (stripNums . map snd) .
-  filter (not . null) . split fst . zip remove . addNums $
-  d
-  where
-    edit (Keep, _) = 0
-    edit _ = 1
-    edits :: [Int]
-    edits = tail $ scanl (+) 0 (map edit d)
-    padEnd _ [] = []
-    padEnd i [a] = replicate i a
-    padEnd i (x:xs) = x : padEnd i xs
-    remove =
-      drop ctxt $
-      zipWith (<=) (padEnd ctxt edits) (replicate (1 + 2 * ctxt) 0 ++ edits)
-    addNums = snd . mapAccumL countTok (0, 0)
-    stripNums = (,) <$> fst . head <*> map snd
-    countTok x@(i, j) d@(op, _) =
-      (,)
-        (case op of
-           Remove -> (i + 1, j)
-           Keep -> (i + 1, j + 1)
-           Add -> (i, j + 1))
-        (x, d)

src/Diff3.hs

@@ -1,7 +1,54 @@
-
 module Diff3 where
 
+import Diff
 import Types
 
-diff3Toks :: BS -> BS -> BS -> TV -> TV -> TV -> a
-diff3Toks = undefined
+data Origin
+  = Stable
+  | Mine
+  | Your
+  deriving (Show, Eq)
+
+--diff3Toks :: TV -> TV -> TV -> Diff
+diff3Toks tMine tOrig tYour =
+  conflict $ align (diffToks tOrig tMine) (diffToks tOrig tYour)
+  where
+    align :: Diff -> Diff -> [(Origin, (Op, Tok))]
+    align ((Keep, a):as) ((Keep, _):bs) = (Stable, (Keep, a)) : align as bs
+    align ((Add, a):as) ((Add, b):bs) =
+      (Mine, (Add, a)) : (Your, (Add, b)) : align as bs
+    align ((Remove, a):as) ((Remove, b):bs) =
+      (Mine, (Remove, a)) : (Your, (Remove, b)) : align as bs
+    align ((Add, a):as) bs@((Keep, _):_) = (Mine, (Add, a)) : align as bs
+    align as@((Keep, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs
+    align ((Remove, a):as) ((Keep, b):bs) =
+      (Mine, (Remove, a)) : (Your, (Keep, b)) : align as bs
+    align ((Keep, a):as) ((Remove, b):bs) =
+      (Mine, (Keep, a)) : (Your, (Remove, b)) : align as bs
+    align ((Add, a):as) bs@((Remove, _):_) = (Mine, (Add, a)) : align as bs
+    align as@((Remove, _):_) ((Add, b):bs) = (Your, (Add, b)) : align as bs
+    align [] [] = []
+    align as@((Add, _):_) [] = map ((,) Mine) as
+    align [] bs@((Add, _):_) = map ((,) Your) bs
+    align _ _ = error "Internal failure: diffstreams seem broken, cannot align"
+    conflict :: [(Origin, (Op, Tok))] -> Diff
+    conflict [] = []
+    conflict as@(a:_)
+      | stable a = applySplit stable (map snd) conflict as
+      | unstable a = applySplit unstable merge conflict as
+    applySplit :: (a -> Bool) -> ([a] -> [b]) -> ([a] -> [b]) -> [a] -> [b]
+    applySplit cond f g xs = f (takeWhile cond xs) ++ g (dropWhile cond xs)
+    merge :: [(Origin, (Op,Tok))] -> Diff
+    merge cs =
+      let mys = map (\a -> map snd $ filter ((== a) . fst) cs) [Mine, Your]
+          [tokOrigsMine, tokOrigsYour] =
+            map (map snd.filter ((/= Add) . fst)) mys
+          [tokMine, tokYour] = map (map snd.filter ((/= Remove) . fst)) mys
+       in if tokOrigsMine /= tokOrigsYour
+            then error "Internal failure: merge origins differ"
+            else map ((,) MineChanged) tokMine ++
+                 map ((,) Original) tokOrigsMine ++
+                 map ((,) YourChanged) tokYour
+    stable (Stable, _) = True
+    stable _ = False
+    unstable = not . stable

src/Format.hs

@@ -24,14 +24,15 @@ pprHunk ((i, j), toks) = B.concat ((pprHunkHdr i j <> lineSep) : map pprDiff1 to
 pprDiff1 (op, (tok, s)) =
   fromString pfx <> escNewlines s <> lineSep
   where
-    pfx =
-      case (op, tok) of
-        (Add, True) -> "+|"
-        (Remove, True) -> "-|"
-        (Keep, True) -> " |"
-        (Add, False) -> "+."
-        (Remove, False) -> "-."
-        (Keep, False) -> " ."
+    pfx = opc:tc:[]
+    opc = case op of
+      Add -> '+'
+      Keep -> ' '
+      Remove -> '-'
+      MineChanged -> '<'
+      Original -> '='
+      YourChanged -> '>'
+    tc = if tok then '|' else '.'
 
 escNewlines = BL.toStrict . BB.toLazyByteString . escNewlines'
 

src/Hunks.hs

@@ -0,0 +1,33 @@
+module Hunks where
+
+import Data.List.Extra
+import Types
+
+hunks :: Int -> Diff -> [Hunk]
+hunks ctxt d =
+  map (stripNums . map snd) .
+  filter (not . null) . split fst . zip remove . addNums $
+  d
+  where
+    edit (Keep, _) = 0
+    edit _ = 1
+    edits :: [Int]
+    edits = tail $ scanl (+) 0 (map edit d)
+    padEnd _ [] = []
+    padEnd i [a] = a : replicate i a
+    padEnd i (x:xs) = x : padEnd i xs
+    remove =
+      drop ctxt $
+      zipWith (<=) (padEnd ctxt edits) (replicate (1 + 2 * ctxt) 0 ++ edits)
+    addNums = snd . mapAccumL countTok (0, 0)
+    stripNums = (,) <$> fst . head <*> map snd
+    countTok x@(i, j) d@(op, _) =
+      (,)
+        (case op of
+           Remove -> (i + 1, j)
+           Keep -> (i + 1, j + 1)
+           Add -> (i, j + 1)
+           MineChanged -> (i, j)
+           Original -> (i + 1, j + 1)
+           YourChanged -> (i, j))
+        (x, d)

src/Main.hs

@@ -1,11 +1,15 @@
 module Main where
 
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Char8 as B8
 import Data.ByteString.UTF8 (fromString)
 import qualified Data.Vector as V
-import Format
+import System.IO (stdout)
 import Diff
+import Diff3
+import Format
+import Hunks
 import Merge
 import Options.Applicative
 import Redfa
@@ -34,7 +38,8 @@ data ADiffCommandOpts
       , patchMergeOpts :: MergeOpts
       }
   | CmdDiff3
-      { diff3Mine :: String
+      { context :: Int
+      , diff3Mine :: String
       , diff3Old :: String
       , diff3Yours :: String
       , diff3MergeOpts :: MergeOpts
@@ -77,7 +82,14 @@ patchCmdOptions =
   mergeOption True
 
 diff3CmdOptions =
-  CmdDiff3 <$> strArgument (metavar "MYFILE") <*>
+  CmdDiff3 <$>
+  option
+    auto
+    (metavar "CONTEXT" <>
+     short 'C' <>
+     long "context" <>
+     value 5 <> help "How many tokens around the change to include in the patch") <*>
+  strArgument (metavar "MYFILE") <*>
   strArgument (metavar "OLDFILE") <*>
   strArgument (metavar "YOURFILE") <*>
   mergeOption False
@@ -113,6 +125,17 @@ main =
              data2 <- mmapFileByteString f2 Nothing
              toks1 <- V.fromList <$> redfaTokenize redfa data1
              toks2 <- V.fromList <$> redfaTokenize redfa data2
-             let hs = hunks (max 0 ctxt) $ diffToks toks1 toks2
-             B8.putStr $ pprHunks hs
+             B8.putStr $ pprHunks $ hunks (max 0 ctxt) $ diffToks toks1 toks2
            CmdPatch {} -> putStrLn "not supported yet"
+           CmdDiff3 ctxt f1 f2 f3 mo -> do
+             [toksMine, toksOld, toksYour] <-
+               map V.fromList <$>
+               traverse
+                 ((>>= redfaTokenize redfa) . flip mmapFileByteString Nothing)
+                 [f1, f2, f3]
+             let d3 = diff3Toks toksMine toksOld toksYour
+             if mergeDoMerge mo
+               then BB.hPutBuilder stdout $ fmtMerged mo d3
+               else B8.putStr $
+                    pprHunks $
+                    hunks (max 0 ctxt) $ diff3Toks toksMine toksOld toksYour

src/Merge.hs

@@ -1,9 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Merge
-  ( MergeOpts
+  ( MergeOpts(..)
   , mergeOption
+  , fmtMerged
   ) where
 
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as BB
 import Data.String
 import Options.Applicative
 import Types
@@ -16,52 +19,86 @@ data MergeOpts =
     , mergeCStartStr :: BS
     , mergeMineSepStr :: BS
     , mergeYourSepStr :: BS
-    , mergeEndStr :: BS
+    , mergeCEndStr :: BS
     }
   deriving (Show)
 
 marker = fromString . replicate 7
 
-mergeOption forPatch =
-  MergeOpts <$>
-  switch
-    (short 'm' <>
-     long "merge" <>
-     help
-       (if forPatch
-          then "Merge using conflict markers instead of printing the rejected hunks"
-          else "Output the merged file instead of the patch")) <*>
-  switch
-    (short 'w' <>
-     long "whitespace" <>
-     help
-       ((if forPatch
-           then "Force rejecting a thunk"
-           else "Force a merge conflict") ++
-        " on whitespace mismatch")) <*>
-  switch
-    (short 'k' <>
-     long "keep-whitespace" <>
-     help
-       ("On whitespace mismatch, default to the version from " ++
-        (if forPatch
-           then "original file"
-           else "MYFILE") ++
-        " instead of the one from " ++
-        (if forPatch
-           then "patch"
-           else "YOURFILE"))) <*>
-  strOption
-    (long "merge-start" <>
-     value (marker '<') <> help "Marker for the beginning of a conflict") <*>
-  strOption
-    (long "merge-mine" <>
-     value (marker '|') <>
-     help "Marker that separates `mine' from `original' part of the conflict") <*>
-  strOption
-    (long "merge-your" <>
-     value (marker '=') <>
-     help "Marker that separates `original' from `your' part of the conflict") <*>
-  strOption
-    (long "merge-end" <>
-     value (marker '>') <> help "Marker for the end of a conflict")
+mergeOption forPatch = addLBR <$> ((,) <$> switch (short 'a' <> long "add-linebreak" <> help "Automatically add a line break after conflict markers") <*> mo)
+  where
+   mo = MergeOpts <$>
+    switch
+      (short 'm' <>
+       long "merge" <>
+       help
+         (if forPatch
+            then "Merge using conflict markers instead of printing the rejected hunks"
+            else "Output the merged file instead of the patch")) <*>
+    switch
+      (short 'w' <>
+       long "whitespace" <>
+       help
+         ((if forPatch
+             then "Force rejecting a thunk"
+             else "Force a merge conflict") ++
+          " on whitespace mismatch")) <*>
+    switch
+      (short 'k' <>
+       long "keep-whitespace" <>
+       help
+         ("On whitespace mismatch, default to the version from " ++
+          (if forPatch
+             then "original file"
+             else "MYFILE") ++
+          " instead of the one from " ++
+          (if forPatch
+             then "patch"
+             else "YOURFILE"))) <*>
+    strOption
+      (long "merge-start" <>
+       value (marker '<') <> help "Marker for the beginning of a conflict") <*>
+    strOption
+      (long "merge-mine" <>
+       value (marker '|') <>
+       help "Marker that separates `mine' from `original' part of the conflict") <*>
+    strOption
+      (long "merge-your" <>
+       value (marker '=') <>
+       help "Marker that separates `original' from `your' part of the conflict") <*>
+    strOption
+      (long "merge-end" <>
+       value (marker '>') <> help "Marker for the end of a conflict")
+   addLBR (False,x)=x
+   addLBR (True,x)=x{
+    mergeCStartStr=mergeCStartStr x <> "\n",
+    mergeMineSepStr=mergeMineSepStr x <> "\n",
+    mergeYourSepStr=mergeYourSepStr x <> "\n",
+    mergeCEndStr=mergeCEndStr x <> "\n"}
+
+{- This kinda relies on reasonable ordering within the conflicts in the Diff -}
+fmtMerged :: MergeOpts -> Diff -> BB.Builder
+fmtMerged mo = go Keep
+  where
+    go op []
+      | conflictOp op = bb $ mergeCEndStr mo
+      | otherwise = mempty
+    go last l@((op, (_, tok)):xs)
+      | conflictOp last && not (conflictOp op) =
+        bb (mergeCEndStr mo) <> go Keep l
+      | not (conflictOp last) && conflictOp op =
+        bb (mergeCStartStr mo) <> go MineChanged l
+      | last /= op && conflictOp op =
+        (case op of
+           MineChanged -> bb $ mergeCStartStr mo
+           Original -> bb $ mergeMineSepStr mo
+           YourChanged -> bb $ mergeYourSepStr mo) <>
+        go op l
+      | otherwise = bb tok <> go op xs
+    conflictOp o =
+      case o of
+        Keep -> False
+        Add -> False
+        Remove -> False
+        _ -> True
+    bb = BB.byteString

src/Redfa.hs

@@ -15,11 +15,9 @@ import Data.Monoid
 import qualified Data.Vector as V
 import Options.Applicative
 import Text.Regex.TDFA
-import Diff
+import Types
 import Substr
 
-type BS = B.ByteString
-
 data RedfaOption
   = RedfaOptionRules [BS]
   | RedfaOptionFile String

src/Types.hs

@@ -17,4 +17,7 @@ data Op
   = Remove
   | Keep
   | Add
+  | MineChanged
+  | Original
+  | YourChanged
   deriving (Show, Eq)