make diff+patch work together, document

Main.hs

@@ -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 m2 o2 y2:xs')
-          Conflict (m1 ++ m2) (o1 ++ o2) (y1 ++ 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
+    go (x@(Replace o1 n1):xs) =
-      (Replace o2 n2:xs') | n > 0 ->
+      case go xs of
-          Replace (o1++o2) (n1++n2): xs'
+        (Replace o2 n2:xs')
+          | n > 0 -> Replace (o1 ++ o2) (n1 ++ n2) : xs'
         (Ok a:Replace o2 n2:xs')
-        | length a < n ->
+          | length a < n -> Replace (o1 ++ a ++ o2) (n1 ++ a ++ n2) : xs'
-          Replace (o1++a++o2) (n1++a++n2): xs'
         xs' -> x : xs'
     go (x:xs) = x : go xs
 
@@ -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 fMy fdMy
-    rundiff fOld fYour fdYour
+    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 fMy fdMy
-        rundiff fOld fYour fdYour
+        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"]
+    let [fOld, fYour, fDiff] = map (workdir </>) ["old", "your", "diff"]
-    for_ [(diffOld, fOld), (diffNew, fNew)] $ \(path, tmp) ->
+    for_ [(diffOld, fOld), (diffYour, fYour)] $ \(path, tmp) ->
       bracketFile path ReadMode $ \h -> hSplitToFile cfg h tmp
-    rundiff fOld fNew fDiff
+    conflicted <-
-    conflicted <- pdiff fDiff >>= format cfg stdout . diff cfg
+      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

Opts.hs

@@ -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'
+      [ flag' True
-          True
+          $ long "add"
-          (long "add"
               <> short 'a'
-             <> help "Run `git add' for fully merged files")
+              <> help "Run `git add' for fully merged files"
-      , flag' False (long "no-add" <> help "Prevent running `git add'")
+      , 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

Progs.hs

@@ -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 ()
+patchProg :: IO String
-rundiff f1 f2 out = do
+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 ()
+hSplit :: Config -> Handle -> Handle -> IO ()
-hSplitToFile cfg h path =
+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

README.md

@@ -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-start "<<<<<"] [--label-mo "|||||"] [--label-diff "|||||"]
-             [--label-end ">>>>>"] COMMAND
+             [--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
+  -C,--expand-context N    Consider changes that are at less than N tokens apart
-                           be a single change. Zero may cause bad resolutions of
+                           to be a single change; 0 turns off conflict
-                           near conflicting edits (default: 1)
+                           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
+```

Toks.hs

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