exa/werge
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

make diff+patch work together, document

Browse source
This commit is contained in:
Mirek Kratochvil 2025-07-18 15:21:08 +02:00
parent 56cf7c69a9
commit cb5257b285
5 changed files with 218 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

82
Main.hs
View file

@ -19,6 +19,8 @@ import Progs
import qualified Toks
import Toks (Tok)
import Debug.Trace
{-
- merge algorithms
-}
@ -42,6 +44,36 @@ data Merged
| Conflict [String] [String] [String]
deriving (Show)
pmerge :: FilePath -> IO [Merged]
pmerge path = go . lines <$> readFile path
where
go [] = []
go xs@(x:_)
| Toks.tok x = goOk xs
| otherwise = goC0 xs
eat = span Toks.tok
goOk xs =
let (a, xs') = eat xs
in Ok a : go xs'
goC0 ("<<<<<<<":xs) =
let (m, xs') = eat xs
in goC1 m xs'
goC0 (x:_) = error $ "unexpected token: " ++ x
goC0 [] = error "unexpected end"
goC1 m ("|||||||":xs) =
let (o, xs') = eat xs
in goC2 m o xs'
goC1 _ (x:_) = error $ "unexpected token: " ++ x
goC1 _ [] = error "unexpected end"
goC2 m o ("=======":xs) =
let (y, xs') = eat xs
in goC3 m o y xs'
goC2 _ _ (x:_) = error $ "unexpected token: " ++ x
goC2 _ _ [] = error "unexpected end"
goC3 m o y (">>>>>>>":xs) = Conflict m o y : go xs
goC3 _ _ _ (x:_) = error $ "unexpected token: " ++ x
goC3 _ _ _ [] = error "unexpected end"
isKeepTok :: (Op, String) -> Bool
isKeepTok (Keep, _) = True
isKeepTok _ = False
@ -182,18 +214,18 @@ expand n = go
go [] = []
go (x@(Conflict m1 o1 y1):xs) =
case go xs of
(Conflict m2 o2 y2:xs') | n > 0 ->
Conflict (m1 ++ m2) (o1 ++ o2) (y1 ++ 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 ->
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'
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'
| length a < n -> Replace (o1 ++ a ++ o2) (n1 ++ a ++ n2) : xs'
xs' -> x : xs'
go (x:xs) = x : go xs
@ -224,7 +256,7 @@ merge cfg@Config {..} ms ys =
. regroup
$ align (chunks ms) (chunks ys)
diff Config{..} = expand cfgContext . chunks
diff Config {..} = expand cfgContext . chunks
{-
- front-end
@ -261,8 +293,8 @@ runCmd CmdDiff3 {..} cfg =
map (workdir </>) ["my", "old", "your", "mydiff", "yourdiff"]
for_ [(d3my, fMy), (d3old, fOld), (d3your, fYour)] $ \(path, tmp) ->
bracketFile path ReadMode $ \h -> hSplitToFile cfg h tmp
rundiff fOld fMy fdMy
rundiff fOld fYour fdYour
runDiff fOld fMy fdMy
runDiff fOld fYour fdYour
conflicted <-
merge cfg <$> pdiff fdMy <*> pdiff fdYour >>= format cfg stdout
if conflicted
@ -280,8 +312,8 @@ runCmd CmdGitMerge {..} cfg = do
let [fMy, fOld, fYour, fdMy, fdYour] =
map (workdir </>) ["my", "old", "your", "mydiff", "yourdiff"]
gitCheckoutMOY cfg u fMy fOld fYour
rundiff fOld fMy fdMy
rundiff fOld fYour fdYour
runDiff fOld fMy fdMy
runDiff fOld fYour fdYour
readFile u >>= writeFile (u ++ ".werge-backup")
conflict <-
bracketFile u WriteMode $ \h ->
@ -293,14 +325,32 @@ runCmd CmdGitMerge {..} cfg = do
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) ->
let [fOld, fYour, fDiff] = map (workdir </>) ["old", "your", "diff"]
for_ [(diffOld, fOld), (diffYour, fYour)] $ \(path, tmp) ->
bracketFile path ReadMode $ \h -> hSplitToFile cfg h tmp
rundiff fOld fNew fDiff
conflicted <- pdiff fDiff >>= format cfg stdout . diff cfg
conflicted <-
case diffUnified of
Just u -> do
c <- runDiffRaw u fOld fYour fDiff
readFile fDiff >>= putStr . unlines . drop 2 . lines
pure c
Nothing -> do
runDiff fOld fYour fDiff
pdiff fDiff >>= format cfg stdout . diff cfg
if conflicted
then exitWith (ExitFailure 1)
else exitSuccess
runCmd CmdPatch {..} cfg = do
withSystemTempDirectory "werge-patch" $ \workdir -> do
let f = workdir </> "file"
bracketFile patchMy ReadMode $ \h -> hSplitToFile cfg h f
_ <- runPatch f stdin
conflicted <- pmerge f >>= format cfg stdout -- TODO try to resolve more?
if conflicted
then exitWith (ExitFailure 1)
else exitSuccess
runCmd CmdBreak cfg = hSplit cfg stdin stdout
runCmd CmdGlue _ = getContents >>= putStr . Toks.glue . Toks.fromFile
main :: IO ()
main = catch go bad

54
Opts.hs
View file

@ -225,8 +225,14 @@ data Command
}
| CmdDiff
{ diffOld :: FilePath
, diffNew :: FilePath
, diffYour :: FilePath
, diffUnified :: Maybe Int
}
| CmdPatch
{ patchMy :: FilePath
}
| CmdBreak
| CmdGlue
deriving (Show)
cmdDiff3 :: Parser Command
@ -254,12 +260,11 @@ cmdGitMerge = do
]
gmDoAdd <-
asum
[ flag'
True
(long "add"
[ flag' True
$ long "add"
<> short 'a'
<> help "Run `git add' for fully merged files")
, flag' False (long "no-add" <> help "Prevent running `git add'")
<> help "Run `git add' for fully merged files"
, flag' False $ long "no-add" <> help "Prevent running `git add'"
, pure False
]
pure CmdGitMerge {..}
@ -267,9 +272,31 @@ cmdGitMerge = do
cmdDiff :: Parser Command
cmdDiff = do
diffOld <- strArgument $ metavar "OLDFILE" <> help "Original file version"
diffNew <- strArgument $ metavar "NEWFILE" <> help "File version with changes"
diffYour <-
strArgument $ metavar "YOURFILE" <> help "File version with changes"
diffUnified <-
asum
[ flag' (Just 20)
$ long "unified"
<> short 'u'
<> help
"Produce unified-diff-like output for `patch' with default context size (20)"
, fmap Just . option auto
$ long "unified-size"
<> short 'U'
<> help "Produce unified diff with this context size"
, flag Nothing Nothing
$ long "merge"
<> short 'm'
<> help "Highlight the differences as with `merge' (default)"
]
pure CmdDiff {..}
cmdPatch :: Parser Command
cmdPatch = do
patchMy <- strArgument $ metavar "MYFILE" <> help "File to be modified"
pure CmdPatch {..}
-- 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
@ -284,12 +311,21 @@ cmd =
$ progDesc "Automerge unmerged files in git conflict"
, command "diff"
$ info cmdDiff
$ progDesc "Highlight differences between two files"
$ progDesc "Find differences between two files"
, command "patch"
$ info cmdPatch
$ progDesc "Apply a patch from `diff' to file"
, command "break"
$ info (pure CmdBreak)
$ progDesc "Break text to tokens"
, command "glue"
$ info (pure CmdGlue)
$ progDesc "Glue tokens back to text"
]
parseOpts :: IO (Config, Command)
parseOpts =
customExecParser (prefs helpShowGlobals)
customExecParser (prefs $ helpShowGlobals <> subparserInline)
$ info
(liftA2 (,) config cmd
<**> helper

40
Progs.hs
View file

@ -21,8 +21,11 @@ bracketFile path mode = bracket (openFile path mode) hClose
diffProg :: IO String
diffProg = fromMaybe "diff" <$> lookupEnv "WERGE_DIFF"
rundiff :: FilePath -> FilePath -> FilePath -> IO ()
rundiff f1 f2 out = do
patchProg :: IO String
patchProg = fromMaybe "patch" <$> lookupEnv "WERGE_PATCH"
runDiff :: FilePath -> FilePath -> FilePath -> IO ()
runDiff f1 f2 out = do
diff <- diffProg
st <-
bracketFile out WriteMode $ \oh ->
@ -41,6 +44,27 @@ rundiff f1 f2 out = do
unless (st `elem` [ExitSuccess, ExitFailure 1])
$ error "diff failed for unknown reason (is GNU diffutils installed?)"
runDiffRaw :: Int -> FilePath -> FilePath -> FilePath -> IO Bool
runDiffRaw u f1 f2 out = do
diff <- diffProg
st <-
bracketFile out WriteMode $ \oh ->
withCreateProcess
(proc diff ["--text", "--unified=" ++ show u, f1, f2])
{std_in = NoStream, std_out = UseHandle oh} $ \_ _ _ -> waitForProcess
unless (st `elem` [ExitSuccess, ExitFailure 1]) $ error "diff failed"
pure (st /= ExitSuccess) -- report if diff thinks that the files differed
runPatch :: FilePath -> Handle -> IO Bool
runPatch f hi = do
patch <- patchProg
st <-
withCreateProcess
(proc patch ["--silent", "--batch", "--merge=diff3", f])
{std_in = UseHandle hi} $ \_ _ _ -> waitForProcess
unless (st `elem` [ExitSuccess, ExitFailure 1]) $ error "patch failed"
pure (st /= ExitSuccess) -- report if patch thinks that stuff has failed
{-
- interface to git
-}
@ -115,17 +139,19 @@ gitAdd path = do
- TODO this might probably enforce joinSpaces?
- or have joinSpaces as configurable? (probably best, default true)
-}
hSplitToFile :: Config -> Handle -> FilePath -> IO ()
hSplitToFile cfg h path =
hSplit :: Config -> Handle -> Handle -> IO ()
hSplit cfg hi ho =
case cfgTokenizer cfg of
TokenizeCharCategory -> internal Toks.splitCategory
TokenizeCharCategorySimple -> internal Toks.splitSimple
TokenizeFilter fltr -> do
st <-
bracketFile path WriteMode $ \ho ->
withCreateProcess
(shell fltr) {std_in = UseHandle h, std_out = UseHandle ho} $ \_ _ _ ->
(shell fltr) {std_in = UseHandle ho, std_out = UseHandle ho} $ \_ _ _ ->
waitForProcess
unless (st == ExitSuccess) $ error "tokenize filter failed"
where
internal s = hGetContents h >>= writeFile path . Toks.toFile . s
internal s = hGetContents hi >>= hPutStr ho . Toks.toFile . s
hSplitToFile :: Config -> Handle -> FilePath -> IO ()
hSplitToFile cfg hi path = bracketFile path WriteMode $ hSplit cfg hi

58
README.md
View file

@ -152,8 +152,8 @@ Usage: werge [(-F|--tok-filter FILTER) | (-i|--simple-tokens) |
[--conflict-space-all] [-C|--expand-context N]
[--resolve (keep|my|old|your)] [--conflict-overlaps]
[--conflict-separate] [--conflict-all] [-G|--color]
[--label-start "<<<<<"] [--label-mo "|||||"] [--label-oy "====="]
[--label-end ">>>>>"] COMMAND
[--label-start "<<<<<"] [--label-mo "|||||"] [--label-diff "|||||"]
[--label-oy "====="] [--label-end ">>>>>"] COMMAND
Available options:
-F,--tok-filter FILTER External program to separate the text to tokens
@ -183,9 +183,10 @@ Available options:
Never resolve separate (non-overlapping) changes in
space-only tokens
--conflict-space-all Never resolve any changes in space-only tokens
-C,--expand-context N Consider changes that are at most N tokens apart to
be a single change. Zero may cause bad resolutions of
near conflicting edits (default: 1)
-C,--expand-context N 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 (default: 2)
--resolve (keep|my|old|your)
Resolve general conflicts in favor of a given
version, or keep the conflicts (default: keep)
@ -198,6 +199,7 @@ Available options:
`less -R')
--label-start "<<<<<" Label for beginning of the conflict
--label-mo "|||||" Separator of local edits and original
--label-diff "|||||" Separator for old and new version
--label-oy "=====" Separator of original and other people's edits
--label-end ">>>>>" Label for end of the conflict
-h,--help Show this help text
@ -206,6 +208,10 @@ Available options:
Available commands:
merge diff3-style merge of two changesets
git Automerge unmerged files in git conflict
diff Find differences between two files
patch Apply a patch from `diff' to file
break Break text to tokens
glue Glue tokens back to text
werge is a free software, use it accordingly.
```
@ -237,3 +243,45 @@ Available options:
--no-add Prevent running `git add'
-h,--help Show this help text
```
#### Finding differences
```
Usage: werge diff OLDFILE YOURFILE
[(-u|--unified) | (-U|--unified-size ARG) | (-m|--merge)]
Find differences between two files
Available options:
OLDFILE Original file version
YOURFILE File version with changes
-u,--unified Produce unified-diff-like output for `patch' with
default context size (20)
-U,--unified-size ARG Produce unified diff with this context size
-m,--merge Highlight the differences as with `merge' (default)
-h,--help Show this help text
```
#### Patching files in place
```
Usage: werge patch MYFILE
Apply a patch from `diff' to file
Available options:
MYFILE File to be modified
-h,--help Show this help text
```
#### Converting between files and tokens
```
Usage: werge break
Break text to tokens
```
```
Usage: werge glue
Glue tokens back to text
```

8
Toks.hs
View file

@ -18,15 +18,19 @@ unescape ('\\':'n':xs) = '\n' : unescape xs
unescape ('\\':_) = error "bad escape on input"
unescape (x:xs) = x : unescape xs
tok ('.':_) = True
tok ('/':_) = True
tok _ = False
markSpace :: String -> Tok
markSpace [] = error "empty token"
markSpace s@(c:_)
| isSpace c = '.' : s
| otherwise = '|' : s
| otherwise = '/' : s
unmarkSpace :: Tok -> String
unmarkSpace ('.':s) = s
unmarkSpace ('|':s) = s
unmarkSpace ('/':s) = s
unmarkSpace _ = error "bad space marking on input"
space :: Tok -> Bool