From 8f9677e40fe7e8e23d07da0b06be04ed10d3f649 Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Wed, 23 Jul 2025 11:15:33 +0200 Subject: [PATCH] improve the patch subcommand a little closes https://github.com/exaexa/werge/issues/1 --- Main.hs | 48 ++++++++++++++++++++++++++++++++++++------------ Opts.hs | 12 ++++++++++-- README.md | 9 ++++++--- 3 files changed, 52 insertions(+), 17 deletions(-) diff --git a/Main.hs b/Main.hs index 4983f64..781f8e8 100644 --- a/Main.hs +++ b/Main.hs @@ -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 diff --git a/Opts.hs b/Opts.hs index 94b0065..fdded5a 100644 --- a/Opts.hs +++ b/Opts.hs @@ -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" diff --git a/README.md b/README.md index e4b9398..62a32bc 100644 --- a/README.md +++ b/README.md @@ -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 ```