diff --git a/Main.hs b/Main.hs index 5ea9b57..37c2ca6 100644 --- a/Main.hs +++ b/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,19 +214,19 @@ 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' - (Ok a:Replace o2 n2:xs') - | length a < n -> - Replace (o1++a++o2) (n1++a++n2): 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' + (Ok a:Replace o2 n2:xs') + | length a < n -> Replace (o1 ++ a ++ o2) (n1 ++ a ++ n2) : xs' + xs' -> x : xs' go (x:xs) = x : go xs resolve :: Config -> Merged -> Merged @@ -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 diff --git a/Opts.hs b/Opts.hs index dcb3330..1c321aa 100644 --- a/Opts.hs +++ b/Opts.hs @@ -224,9 +224,15 @@ data Command , gmDoAdd :: Bool } | CmdDiff - { diffOld :: FilePath - , diffNew :: FilePath - } + { diffOld :: 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" - <> short 'a' - <> help "Run `git add' for fully merged files") - , flag' False (long "no-add" <> help "Prevent running `git 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'" , 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 diff --git a/Progs.hs b/Progs.hs index bb20726..1eb404e 100644 --- a/Progs.hs +++ b/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 () -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} $ \_ _ _ -> - waitForProcess + withCreateProcess + (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 diff --git a/README.md b/README.md index 89f1307..5f9dda2 100644 --- a/README.md +++ b/README.md @@ -144,16 +144,16 @@ automatically to `filename.werge-backup`. ``` werge -- blanks-friendly mergetool for tiny interdwindled changes -Usage: werge [(-F|--tok-filter FILTER) | (-i|--simple-tokens) | - (-I|--full-tokens)] [--no-zeal | (-z|--zeal)] - [-S|--space (keep|my|old|your)] - [-s | --resolve-space (normal|keep|my|old|your)] - [--conflict-space-overlaps] [--conflict-space-separate] - [--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 +Usage: werge [(-F|--tok-filter FILTER) | (-i|--simple-tokens) | + (-I|--full-tokens)] [--no-zeal | (-z|--zeal)] + [-S|--space (keep|my|old|your)] + [-s | --resolve-space (normal|keep|my|old|your)] + [--conflict-space-overlaps] [--conflict-space-separate] + [--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-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 +``` diff --git a/Toks.hs b/Toks.hs index 54240e1..8eb7eb7 100644 --- a/Toks.hs +++ b/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