From 56cf7c69a948ee04100b8363206b51d680bc4664 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Thu, 17 Jul 2025 22:21:23 +0200 Subject: [PATCH] have diffs (for good manners) --- Main.hs | 29 ++++++++++++++++++++++++++--- Opts.hs | 25 +++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 5 deletions(-) diff --git a/Main.hs b/Main.hs index b8e2ce4..5ea9b57 100644 --- a/Main.hs +++ b/Main.hs @@ -182,12 +182,19 @@ expand n = go go [] = [] go (x@(Conflict m1 o1 y1):xs) = case go xs of - (Conflict m2 o2 y2:xs') -> + (Conflict m2 o2 y2:xs') | n > 0 -> Conflict (m1 ++ m2) (o1 ++ o2) (y1 ++ y2) : xs' (Ok a:Conflict m2 o2 y2:xs') - | length a <= n -> + | length a < n -> Conflict (m1 ++ a ++ m2) (o1 ++ a ++ o2) (y1 ++ a ++ y2) : xs' xs' -> x : xs' + go (x@(Replace o1 n1):xs) = case go xs of + (Replace o2 n2:xs') | n > 0 -> + Replace (o1++o2) (n1++n2): xs' + (Ok a:Replace o2 n2:xs') + | length a < n -> + Replace (o1++a++o2) (n1++a++n2): xs' + xs' -> x : xs' go (x:xs) = x : go xs resolve :: Config -> Merged -> Merged @@ -217,6 +224,8 @@ merge cfg@Config {..} ms ys = . regroup $ align (chunks ms) (chunks ys) +diff Config{..} = expand cfgContext . chunks + {- - front-end -} @@ -239,7 +248,11 @@ format Config {..} h = go False , cfgLabelEnd ] go True xs - go _ _ = error "bad format (replace)" + go _ (Replace o n:xs) = do + hPutStr h + $ mconcat + [cfgLabelStart, Toks.glue o, cfgLabelDiff, Toks.glue n, cfgLabelEnd] + go True xs runCmd :: Command -> Config -> IO () runCmd CmdDiff3 {..} cfg = @@ -278,6 +291,16 @@ runCmd CmdGitMerge {..} cfg = do if or conflicts then exitWith (ExitFailure 1) else exitSuccess +runCmd CmdDiff {..} cfg = do + withSystemTempDirectory "werge-diff" $ \workdir -> do + let [fOld, fNew, fDiff] = map (workdir ) ["old", "new", "diff"] + for_ [(diffOld, fOld), (diffNew, fNew)] $ \(path, tmp) -> + bracketFile path ReadMode $ \h -> hSplitToFile cfg h tmp + rundiff fOld fNew fDiff + conflicted <- pdiff fDiff >>= format cfg stdout . diff cfg + if conflicted + then exitWith (ExitFailure 1) + else exitSuccess main :: IO () main = catch go bad diff --git a/Opts.hs b/Opts.hs index dc6987f..dcb3330 100644 --- a/Opts.hs +++ b/Opts.hs @@ -110,6 +110,7 @@ data Config = Config , cfgConflicts :: ConflictMask , cfgLabelStart :: String , cfgLabelMyOld :: String + , cfgLabelDiff :: String , cfgLabelOldYour :: String , cfgLabelEnd :: String } deriving (Show) @@ -154,10 +155,10 @@ config = do $ long "expand-context" <> short 'C' <> metavar "N" - <> value 1 + <> value 2 <> showDefault <> help - "Consider changes that are at most N tokens apart to be a single change. Zero may cause bad resolutions of near conflicting edits" + "Consider changes that are at less than N tokens apart to be a single change; 0 turns off conflict expansion, 1 may cause bad resolutions of near conflicting edits" cfgResolution <- option (eitherReader resolutionMode) $ long "resolve" @@ -182,6 +183,11 @@ config = do $ long "label-mo" <> metavar "\"|||||\"" <> help "Separator of local edits and original" + labelDiff <- + optional . strOption + $ long "label-diff" + <> metavar "\"|||||\"" + <> help "Separator for old and new version" labelOldYour <- optional . strOption $ long "label-oy" @@ -198,6 +204,8 @@ config = do bool "<<<<<" "\ESC[1;37m<\ESC[0;31m" color `fromMaybe` labelStart , cfgLabelMyOld = bool "|||||" "\ESC[1;37m|\ESC[1;30m" color `fromMaybe` labelMyOld + , cfgLabelDiff = + bool "|||||" "\ESC[1;37m|\ESC[0;32m" color `fromMaybe` labelDiff , cfgLabelOldYour = bool "=====" "\ESC[1;37m=\ESC[0;32m" color `fromMaybe` labelOldYour , cfgLabelEnd = @@ -215,6 +223,10 @@ data Command { gmFiles :: Maybe [FilePath] , gmDoAdd :: Bool } + | CmdDiff + { diffOld :: FilePath + , diffNew :: FilePath + } deriving (Show) cmdDiff3 :: Parser Command @@ -252,6 +264,12 @@ cmdGitMerge = do ] pure CmdGitMerge {..} +cmdDiff :: Parser Command +cmdDiff = do + diffOld <- strArgument $ metavar "OLDFILE" <> help "Original file version" + diffNew <- strArgument $ metavar "NEWFILE" <> help "File version with changes" + pure CmdDiff {..} + -- TODO have some option to output the (partially merged) my/old/your files so -- that folks can continue with external program or so (such as meld) cmd :: Parser Command @@ -264,6 +282,9 @@ cmd = , command "git" $ info cmdGitMerge $ progDesc "Automerge unmerged files in git conflict" + , command "diff" + $ info cmdDiff + $ progDesc "Highlight differences between two files" ] parseOpts :: IO (Config, Command)