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