improve the patch subcommand a little

closes https://github.com/exaexa/werge/issues/1

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