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 [] = [] | ||||||
|     go (x@(Conflict m1 o1 y1):xs) = |     go (x@(Conflict m1 o1 y1):xs) = | ||||||
|       case go xs of |       case go xs of | ||||||
|         (Conflict m2 o2 y2:xs') -> |         (Conflict m2 o2 y2:xs') | n > 0 -> | ||||||
|           Conflict (m1 ++ m2) (o1 ++ o2) (y1 ++ y2) : xs' |           Conflict (m1 ++ m2) (o1 ++ o2) (y1 ++ y2) : xs' | ||||||
|         (Ok a:Conflict m2 o2 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' |             Conflict (m1 ++ a ++ m2) (o1 ++ a ++ o2) (y1 ++ a ++ y2) : xs' | ||||||
|         xs' -> x : 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 |     go (x:xs) = x : go xs | ||||||
| 
 | 
 | ||||||
| resolve :: Config -> Merged -> Merged | resolve :: Config -> Merged -> Merged | ||||||
|  | @ -217,6 +224,8 @@ merge cfg@Config {..} ms ys = | ||||||
|     . regroup |     . regroup | ||||||
|     $ align (chunks ms) (chunks ys) |     $ align (chunks ms) (chunks ys) | ||||||
| 
 | 
 | ||||||
|  | diff Config{..} = expand cfgContext . chunks | ||||||
|  | 
 | ||||||
| {- | {- | ||||||
|  - front-end |  - front-end | ||||||
|  -} |  -} | ||||||
|  | @ -239,7 +248,11 @@ format Config {..} h = go False | ||||||
|             , cfgLabelEnd |             , cfgLabelEnd | ||||||
|             ] |             ] | ||||||
|       go True xs |       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 :: Command -> Config -> IO () | ||||||
| runCmd CmdDiff3 {..} cfg = | runCmd CmdDiff3 {..} cfg = | ||||||
|  | @ -278,6 +291,16 @@ runCmd CmdGitMerge {..} cfg = do | ||||||
|   if or conflicts |   if or conflicts | ||||||
|     then exitWith (ExitFailure 1) |     then exitWith (ExitFailure 1) | ||||||
|     else exitSuccess |     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 :: IO () | ||||||
| main = catch go bad | main = catch go bad | ||||||
|  |  | ||||||
							
								
								
									
										25
									
								
								Opts.hs
									
									
									
									
									
								
							
							
						
						
									
										25
									
								
								Opts.hs
									
									
									
									
									
								
							|  | @ -110,6 +110,7 @@ data Config = Config | ||||||
|   , cfgConflicts :: ConflictMask |   , cfgConflicts :: ConflictMask | ||||||
|   , cfgLabelStart :: String |   , cfgLabelStart :: String | ||||||
|   , cfgLabelMyOld :: String |   , cfgLabelMyOld :: String | ||||||
|  |   , cfgLabelDiff :: String | ||||||
|   , cfgLabelOldYour :: String |   , cfgLabelOldYour :: String | ||||||
|   , cfgLabelEnd :: String |   , cfgLabelEnd :: String | ||||||
|   } deriving (Show) |   } deriving (Show) | ||||||
|  | @ -154,10 +155,10 @@ config = do | ||||||
|       $ long "expand-context" |       $ long "expand-context" | ||||||
|           <> short 'C' |           <> short 'C' | ||||||
|           <> metavar "N" |           <> metavar "N" | ||||||
|           <> value 1 |           <> value 2 | ||||||
|           <> showDefault |           <> showDefault | ||||||
|           <> help |           <> 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 <- |   cfgResolution <- | ||||||
|     option (eitherReader resolutionMode) |     option (eitherReader resolutionMode) | ||||||
|       $ long "resolve" |       $ long "resolve" | ||||||
|  | @ -182,6 +183,11 @@ config = do | ||||||
|       $ long "label-mo" |       $ long "label-mo" | ||||||
|           <> metavar "\"|||||\"" |           <> metavar "\"|||||\"" | ||||||
|           <> help "Separator of local edits and original" |           <> help "Separator of local edits and original" | ||||||
|  |   labelDiff <- | ||||||
|  |     optional . strOption | ||||||
|  |       $ long "label-diff" | ||||||
|  |           <> metavar "\"|||||\"" | ||||||
|  |           <> help "Separator for old and new version" | ||||||
|   labelOldYour <- |   labelOldYour <- | ||||||
|     optional . strOption |     optional . strOption | ||||||
|       $ long "label-oy" |       $ long "label-oy" | ||||||
|  | @ -198,6 +204,8 @@ config = do | ||||||
|           bool "<<<<<" "\ESC[1;37m<\ESC[0;31m" color `fromMaybe` labelStart |           bool "<<<<<" "\ESC[1;37m<\ESC[0;31m" color `fromMaybe` labelStart | ||||||
|       , cfgLabelMyOld = |       , cfgLabelMyOld = | ||||||
|           bool "|||||" "\ESC[1;37m|\ESC[1;30m" color `fromMaybe` labelMyOld |           bool "|||||" "\ESC[1;37m|\ESC[1;30m" color `fromMaybe` labelMyOld | ||||||
|  |       , cfgLabelDiff = | ||||||
|  |           bool "|||||" "\ESC[1;37m|\ESC[0;32m" color `fromMaybe` labelDiff | ||||||
|       , cfgLabelOldYour = |       , cfgLabelOldYour = | ||||||
|           bool "=====" "\ESC[1;37m=\ESC[0;32m" color `fromMaybe` labelOldYour |           bool "=====" "\ESC[1;37m=\ESC[0;32m" color `fromMaybe` labelOldYour | ||||||
|       , cfgLabelEnd = |       , cfgLabelEnd = | ||||||
|  | @ -215,6 +223,10 @@ data Command | ||||||
|       { gmFiles :: Maybe [FilePath] |       { gmFiles :: Maybe [FilePath] | ||||||
|       , gmDoAdd :: Bool |       , gmDoAdd :: Bool | ||||||
|       } |       } | ||||||
|  |   | CmdDiff | ||||||
|  |     { diffOld :: FilePath | ||||||
|  |     , diffNew :: FilePath | ||||||
|  |     } | ||||||
|   deriving (Show) |   deriving (Show) | ||||||
| 
 | 
 | ||||||
| cmdDiff3 :: Parser Command | cmdDiff3 :: Parser Command | ||||||
|  | @ -252,6 +264,12 @@ cmdGitMerge = do | ||||||
|       ] |       ] | ||||||
|   pure CmdGitMerge {..} |   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 | -- 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) | -- that folks can continue with external program or so (such as meld) | ||||||
| cmd :: Parser Command | cmd :: Parser Command | ||||||
|  | @ -264,6 +282,9 @@ cmd = | ||||||
|         , command "git" |         , command "git" | ||||||
|             $ info cmdGitMerge |             $ info cmdGitMerge | ||||||
|             $ progDesc "Automerge unmerged files in git conflict" |             $ progDesc "Automerge unmerged files in git conflict" | ||||||
|  |         , command "diff" | ||||||
|  |             $ info cmdDiff | ||||||
|  |             $ progDesc "Highlight differences between two files" | ||||||
|         ] |         ] | ||||||
| 
 | 
 | ||||||
| parseOpts :: IO (Config, Command) | parseOpts :: IO (Config, Command) | ||||||
|  |  | ||||||
		Loading…
	
		Reference in a new issue