From 114a333982e2da27ccc07e9c465f7ec226008346 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Sun, 27 Sep 2020 14:42:55 +0200 Subject: [PATCH] merging merges --- adiff.cabal | 1 + src/Diff.hs | 31 +----------- src/Diff3.hs | 53 +++++++++++++++++++-- src/Format.hs | 17 +++---- src/Hunks.hs | 33 +++++++++++++ src/Main.hs | 33 +++++++++++-- src/Merge.hs | 127 ++++++++++++++++++++++++++++++++------------------ src/Redfa.hs | 4 +- src/Types.hs | 3 ++ 9 files changed, 208 insertions(+), 94 deletions(-) create mode 100644 src/Hunks.hs diff --git a/adiff.cabal b/adiff.cabal index 38c1de1..30a668f 100644 --- a/adiff.cabal +++ b/adiff.cabal @@ -46,6 +46,7 @@ executable adiff other-modules: Diff, Diff3, Format, + Hunks, Merge, Patch, Redfa, diff --git a/src/Diff.hs b/src/Diff.hs index 45bc5c7..e480784 100644 --- a/src/Diff.hs +++ b/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) diff --git a/src/Diff3.hs b/src/Diff3.hs index b6c2092..15edbee 100644 --- a/src/Diff3.hs +++ b/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 diff --git a/src/Format.hs b/src/Format.hs index b69a624..3bd167b 100644 --- a/src/Format.hs +++ b/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' diff --git a/src/Hunks.hs b/src/Hunks.hs new file mode 100644 index 0000000..aabae99 --- /dev/null +++ b/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) diff --git a/src/Main.hs b/src/Main.hs index 9faad08..e972ed8 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Merge.hs b/src/Merge.hs index 674d508..7f5b39c 100644 --- a/src/Merge.hs +++ b/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 diff --git a/src/Redfa.hs b/src/Redfa.hs index 5cccdf0..0e9720e 100644 --- a/src/Redfa.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index d8add21..93698db 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -17,4 +17,7 @@ data Op = Remove | Keep | Add + | MineChanged + | Original + | YourChanged deriving (Show, Eq)