improve the patch subcommand a little

closes https://github.com/exaexa/werge/issues/1
This commit is contained in:
Mirek Kratochvil 2025-07-23 11:15:33 +02:00
parent b52b106ac5
commit 8f9677e40f
3 changed files with 52 additions and 17 deletions

48
Main.hs
View file

@ -30,13 +30,16 @@ data Op
| Add
deriving (Show, Eq)
pdiff :: FilePath -> IO [(Op, Tok)]
pdiff path = map go . lines <$> readFile path
pdiff' :: [String] -> [(Op, Tok)]
pdiff' = map go
where
go ('-':s) = (Del, s)
go (' ':s) = (Keep, s)
go ('+':s) = (Add, s)
go _ = error "unexpected output from diff"
go _ = error "unexpected contents in diff"
pdiff :: FilePath -> IO [(Op, Tok)]
pdiff path = pdiff' . lines <$> readFile path
data Merged
= Ok [String]
@ -286,6 +289,21 @@ format Config {..} h = go False
[cfgLabelStart, Toks.glue o, cfgLabelDiff, Toks.glue n, cfgLabelEnd]
go True xs
fmtPatch :: Config -> Handle -> Handle -> IO ()
fmtPatch cfg out h = hGetContents h >>= go . lines
where
go all@(l:ls)
| patchLine l = do
let (p, ls') = span patchLine all
format cfg out . chunks $ pdiff' p
go ls'
| otherwise = hPutStrLn out l >> go ls
go [] = pure ()
patchLine (' ':_) = True
patchLine ('-':_) = True
patchLine ('+':_) = True
patchLine _ = False
runCmd :: Command -> Config -> IO ()
runCmd CmdDiff3 {..} cfg =
withSystemTempDirectory "werge-diff3" $ \workdir -> do
@ -343,15 +361,21 @@ runCmd CmdDiff {..} cfg = do
runCmd CmdPatch {..} cfg = do
withSystemTempDirectory "werge-patch" $ \workdir -> do
let f = workdir </> "file"
bracketFile patchMy ReadMode $ \h -> hSplitToFile cfg h f
_ <-
case patchInput of
Nothing -> runPatch f stdin
Just path -> bracketFile path ReadMode $ runPatch f
conflicted <- pmerge f >>= format cfg stdout -- TODO try to resolve more?
if conflicted
then exitWith (ExitFailure 1)
else exitSuccess
case patchTarget of
Just patchMy -> do
bracketFile patchMy ReadMode $ \h -> hSplitToFile cfg h f
_ <-
case patchInput of
Nothing -> runPatch f stdin
Just path -> bracketFile path ReadMode $ runPatch f
conflicted <- pmerge f >>= format cfg stdout -- TODO try to resolve more?
if conflicted
then exitWith (ExitFailure 1)
else exitSuccess
Nothing -> do
case patchInput of
Nothing -> fmtPatch cfg stdout stdin
Just path -> bracketFile path ReadMode $ fmtPatch cfg stdout
runCmd CmdBreak cfg = hSplit cfg stdin stdout
runCmd CmdGlue _ = getContents >>= putStr . Toks.glue . Toks.fromFile

12
Opts.hs
View file

@ -229,7 +229,7 @@ data Command
, diffUnified :: Maybe Int
}
| CmdPatch
{ patchMy :: FilePath
{ patchTarget :: Maybe FilePath
, patchInput :: Maybe FilePath
}
| CmdBreak
@ -295,7 +295,15 @@ cmdDiff = do
cmdPatch :: Parser Command
cmdPatch = do
patchMy <- strArgument $ metavar "MYFILE" <> help "File to be modified"
patchTarget <-
asum
[ Just <$> strArgument (metavar "MYFILE" <> help "File to be patched")
, flag' Nothing
$ long "format"
<> short 'f'
<> help
"Do not patch anything, only format the patch using conflict marks on joined tokens"
]
patchInput <-
optional . strOption
$ long "patch"

View file

@ -279,12 +279,15 @@ Available options:
#### Patching files in place
```
Usage: werge patch MYFILE
Usage: werge patch (MYFILE | (-f|--format)) [-p|--patch PATCH]
Apply a patch from `diff' to file
Modify a file using a patch from `diff'
Available options:
MYFILE File to be modified
MYFILE File to be patched
-f,--format Do not patch anything, only format the patch using
conflict marks on joined tokens
-p,--patch PATCH File with the patch (default: stdin)
-h,--help Show this help text
```