have diffs (for good manners)
This commit is contained in:
parent
49fcd0ca44
commit
56cf7c69a9
29
Main.hs
29
Main.hs
|
|
@ -182,12 +182,19 @@ expand n = go
|
|||
go [] = []
|
||||
go (x@(Conflict m1 o1 y1):xs) =
|
||||
case go xs of
|
||||
(Conflict m2 o2 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 ->
|
||||
| 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:xs) = x : go xs
|
||||
|
||||
resolve :: Config -> Merged -> Merged
|
||||
|
|
@ -217,6 +224,8 @@ merge cfg@Config {..} ms ys =
|
|||
. regroup
|
||||
$ align (chunks ms) (chunks ys)
|
||||
|
||||
diff Config{..} = expand cfgContext . chunks
|
||||
|
||||
{-
|
||||
- front-end
|
||||
-}
|
||||
|
|
@ -239,7 +248,11 @@ format Config {..} h = go False
|
|||
, cfgLabelEnd
|
||||
]
|
||||
go True xs
|
||||
go _ _ = error "bad format (replace)"
|
||||
go _ (Replace o n:xs) = do
|
||||
hPutStr h
|
||||
$ mconcat
|
||||
[cfgLabelStart, Toks.glue o, cfgLabelDiff, Toks.glue n, cfgLabelEnd]
|
||||
go True xs
|
||||
|
||||
runCmd :: Command -> Config -> IO ()
|
||||
runCmd CmdDiff3 {..} cfg =
|
||||
|
|
@ -278,6 +291,16 @@ runCmd CmdGitMerge {..} cfg = do
|
|||
if or conflicts
|
||||
then exitWith (ExitFailure 1)
|
||||
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) ->
|
||||
bracketFile path ReadMode $ \h -> hSplitToFile cfg h tmp
|
||||
rundiff fOld fNew fDiff
|
||||
conflicted <- pdiff fDiff >>= format cfg stdout . diff cfg
|
||||
if conflicted
|
||||
then exitWith (ExitFailure 1)
|
||||
else exitSuccess
|
||||
|
||||
main :: IO ()
|
||||
main = catch go bad
|
||||
|
|
|
|||
25
Opts.hs
25
Opts.hs
|
|
@ -110,6 +110,7 @@ data Config = Config
|
|||
, cfgConflicts :: ConflictMask
|
||||
, cfgLabelStart :: String
|
||||
, cfgLabelMyOld :: String
|
||||
, cfgLabelDiff :: String
|
||||
, cfgLabelOldYour :: String
|
||||
, cfgLabelEnd :: String
|
||||
} deriving (Show)
|
||||
|
|
@ -154,10 +155,10 @@ config = do
|
|||
$ long "expand-context"
|
||||
<> short 'C'
|
||||
<> metavar "N"
|
||||
<> value 1
|
||||
<> value 2
|
||||
<> showDefault
|
||||
<> help
|
||||
"Consider changes that are at most N tokens apart to be a single change. Zero may cause bad resolutions of near conflicting edits"
|
||||
"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"
|
||||
cfgResolution <-
|
||||
option (eitherReader resolutionMode)
|
||||
$ long "resolve"
|
||||
|
|
@ -182,6 +183,11 @@ config = do
|
|||
$ long "label-mo"
|
||||
<> metavar "\"|||||\""
|
||||
<> help "Separator of local edits and original"
|
||||
labelDiff <-
|
||||
optional . strOption
|
||||
$ long "label-diff"
|
||||
<> metavar "\"|||||\""
|
||||
<> help "Separator for old and new version"
|
||||
labelOldYour <-
|
||||
optional . strOption
|
||||
$ long "label-oy"
|
||||
|
|
@ -198,6 +204,8 @@ config = do
|
|||
bool "<<<<<" "\ESC[1;37m<\ESC[0;31m" color `fromMaybe` labelStart
|
||||
, cfgLabelMyOld =
|
||||
bool "|||||" "\ESC[1;37m|\ESC[1;30m" color `fromMaybe` labelMyOld
|
||||
, cfgLabelDiff =
|
||||
bool "|||||" "\ESC[1;37m|\ESC[0;32m" color `fromMaybe` labelDiff
|
||||
, cfgLabelOldYour =
|
||||
bool "=====" "\ESC[1;37m=\ESC[0;32m" color `fromMaybe` labelOldYour
|
||||
, cfgLabelEnd =
|
||||
|
|
@ -215,6 +223,10 @@ data Command
|
|||
{ gmFiles :: Maybe [FilePath]
|
||||
, gmDoAdd :: Bool
|
||||
}
|
||||
| CmdDiff
|
||||
{ diffOld :: FilePath
|
||||
, diffNew :: FilePath
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
cmdDiff3 :: Parser Command
|
||||
|
|
@ -252,6 +264,12 @@ cmdGitMerge = do
|
|||
]
|
||||
pure CmdGitMerge {..}
|
||||
|
||||
cmdDiff :: Parser Command
|
||||
cmdDiff = do
|
||||
diffOld <- strArgument $ metavar "OLDFILE" <> help "Original file version"
|
||||
diffNew <- strArgument $ metavar "NEWFILE" <> help "File version with changes"
|
||||
pure CmdDiff {..}
|
||||
|
||||
-- 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
|
||||
|
|
@ -264,6 +282,9 @@ cmd =
|
|||
, command "git"
|
||||
$ info cmdGitMerge
|
||||
$ progDesc "Automerge unmerged files in git conflict"
|
||||
, command "diff"
|
||||
$ info cmdDiff
|
||||
$ progDesc "Highlight differences between two files"
|
||||
]
|
||||
|
||||
parseOpts :: IO (Config, Command)
|
||||
|
|
|
|||
Loading…
Reference in a new issue