have diffs (for good manners)

This commit is contained in:
Mirek Kratochvil 2025-07-17 22:21:23 +02:00
parent 49fcd0ca44
commit 56cf7c69a9
2 changed files with 49 additions and 5 deletions

29
Main.hs
View file

@ -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

25
Opts.hs
View file

@ -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)