resolve-trivial-conflicts 0.3.0.1 → 0.3.0.2
raw patch · 3 files changed
+74/−53 lines, 3 files
Files
- PPDiff.hs +1/−1
- resolve-trivial-conflicts.cabal +1/−1
- resolve_trivial_conflicts.hs +72/−51
PPDiff.hs view
@@ -15,4 +15,4 @@ ppDiff :: ColorEnable -> Diff String -> String ppDiff c (First x) = wrap c Red $ '-':x ppDiff c (Second x) = wrap c Green $ '+':x-ppDiff c (Both x _) = ' ':x+ppDiff c (Both x _) = ' ':x
resolve-trivial-conflicts.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: resolve-trivial-conflicts-version: 0.3.0.1+version: 0.3.0.2 synopsis: Remove trivial conflict markers in a git repository description: Remove trivial conflict markers in a git repository homepage: https://github.com/ElastiLotem/resolve-trivial-conflicts
resolve_trivial_conflicts.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS -O2 -Wall #-} {-# LANGUAGE FlexibleContexts, RecordWildCards #-}+module Main (main) where import Control.Applicative ((<$>)) import qualified Control.Exception as E@@ -12,10 +13,11 @@ import Data.Monoid (Monoid(..)) import qualified Data.Monoid as Monoid import PPDiff (ppDiff, ColorEnable(..))-import System.Directory (renameFile, removeFile)+import System.Directory (renameFile, removeFile, getCurrentDirectory) import System.Environment (getProgName, getArgs, getEnv) import System.Exit (ExitCode(..))-import System.FilePath ((<.>), (</>))+import System.FilePath ((<.>), makeRelative, joinPath, splitPath)+import qualified System.FilePath as FilePath import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) import System.Process (callProcess, readProcess, readProcessWithExitCode)@@ -25,30 +27,29 @@ type LineNo = Int data Conflict = Conflict- { _lineNo :: LineNo- , _markerA :: String -- <<<<<<<....- , _markerBase :: String -- |||||||....- , _markerB :: String -- =======....- , _markerEnd :: String -- >>>>>>>....- , _linesA :: [String]- , _linesBase :: [String]- , _linesB :: [String]+ { cMarkerA :: (LineNo, String) -- <<<<<<<....+ , cMarkerBase :: (LineNo, String) -- |||||||....+ , cMarkerB :: (LineNo, String) -- =======....+ , cMarkerEnd :: (LineNo, String) -- >>>>>>>....+ , cLinesA :: [String]+ , cLinesBase :: [String]+ , cLinesB :: [String] } deriving (Show) prettyConflict :: Conflict -> String-prettyConflict (Conflict _ markerA markerBase markerB markerEnd linesA linesBase linesB) =+prettyConflict Conflict {..} = unlines $ concat- [ markerA : linesA- , markerBase : linesBase- , markerB : linesB- , [markerEnd]+ [ snd cMarkerA : cLinesA+ , snd cMarkerBase : cLinesBase+ , snd cMarkerB : cLinesB+ , [snd cMarkerEnd] ] resolveConflict :: Conflict -> Maybe String resolveConflict Conflict{..}- | _linesA == _linesBase = Just $ unlines _linesB- | _linesB == _linesBase = Just $ unlines _linesA- | _linesA == _linesB = Just $ unlines _linesA+ | cLinesA == cLinesBase = Just $ unlines cLinesB+ | cLinesB == cLinesBase = Just $ unlines cLinesA+ | cLinesA == cLinesB = Just $ unlines cLinesA | otherwise = Nothing breakUpToMarker :: MonadState [(LineNo, String)] m => Char -> m [(LineNo, String)]@@ -67,20 +68,19 @@ mHead <- readHead return (ls, mHead) -parseConflict :: MonadState [(LineNo, String)] m => LineNo -> String -> m Conflict-parseConflict lineNo markerA = do- (linesA , Just (_, markerBase)) <- readUpToMarker '|'- (linesBase, Just (_, markerB)) <- readUpToMarker '='- (linesB , Just (_, markerEnd)) <- readUpToMarker '>'+parseConflict :: MonadState [(LineNo, String)] m => (LineNo, String) -> m Conflict+parseConflict markerA = do+ (linesA , Just markerBase) <- readUpToMarker '|'+ (linesBase, Just markerB) <- readUpToMarker '='+ (linesB , Just markerEnd) <- readUpToMarker '>' return Conflict- { _lineNo = lineNo- , _markerA = markerA- , _markerBase = markerBase- , _markerB = markerB- , _markerEnd = markerEnd- , _linesA = map snd linesA- , _linesB = map snd linesB- , _linesBase = map snd linesBase+ { cMarkerA = markerA+ , cMarkerBase = markerBase+ , cMarkerB = markerB+ , cMarkerEnd = markerEnd+ , cLinesA = map snd linesA+ , cLinesB = map snd linesB+ , cLinesBase = map snd linesBase } parseConflicts :: String -> [Either String Conflict]@@ -93,42 +93,38 @@ tell $ map (Left . snd) ls case mMarkerA of Nothing -> return ()- Just (lineNo, markerA) ->+ Just markerA -> do- tell . return . Right =<< parseConflict lineNo markerA+ tell . return . Right =<< parseConflict markerA loop -type SideDiff = (Side, LineNo, [Diff String])+type SideDiff = (Side, (LineNo, String), [Diff String]) data NewContent = NewContent { _resolvedSuccessfully :: Int , _failedToResolve :: Int , _newContent :: String- , _diffs :: [SideDiff] } getConflictDiffs :: Conflict -> [SideDiff] getConflictDiffs Conflict{..} =- [ (A, _lineNo, getDiff _linesBase _linesA) | not (null _linesA) ] ++- [ (B, _lineNo, getDiff _linesBase _linesB) | not (null _linesB) ]+ [ (A, cMarkerA, getDiff cLinesBase cLinesA) | not (null cLinesA) ] +++ [ (B, (fst cMarkerB, snd cMarkerEnd), getDiff cLinesBase cLinesB) | not (null cLinesB) ] resolveContent :: [Either String Conflict] -> NewContent resolveContent = asResult . mconcat . map go where- asResult (Monoid.Sum successes, Monoid.Sum failures, newContent, diffs) = NewContent+ asResult (Monoid.Sum successes, Monoid.Sum failures, newContent) =+ NewContent { _resolvedSuccessfully = successes , _failedToResolve = failures , _newContent = newContent- , _diffs = diffs }- go (Left line) = (Monoid.Sum 0, Monoid.Sum 0, unlines [line], [])+ go (Left line) = (Monoid.Sum 0, Monoid.Sum 0, unlines [line]) go (Right conflict) = case resolveConflict conflict of- Nothing ->- ( Monoid.Sum 0, Monoid.Sum 1, prettyConflict conflict- , getConflictDiffs conflict- )- Just trivialLines -> (Monoid.Sum 1, Monoid.Sum 0, trivialLines, [])+ Nothing -> (Monoid.Sum 0, Monoid.Sum 1, prettyConflict conflict)+ Just trivialLines -> (Monoid.Sum 1, Monoid.Sum 0, trivialLines) gitAdd :: FilePath -> IO () gitAdd fileName =@@ -191,9 +187,10 @@ | shouldDumpDiffs opts = mapM_ dumpDiff diffs | otherwise = return () where- dumpDiff (side, lineNo, diff) =+ dumpDiff (side, (lineNo, marker), diff) = do- putStrLn $ filePath ++ ":" ++ show lineNo ++ ":Diff" ++ show side+ putStrLn $ concat+ [filePath, ":", show lineNo, ":Diff", show side, ": ", marker] putStr $ unlines $ map (ppDiff colorEnable) diff dumpAndOpenEditor :: ColorEnable -> Options -> FilePath -> [SideDiff] -> IO ()@@ -207,7 +204,7 @@ do content <- parseConflicts <$> readFile fileName case resolveContent content of- NewContent successes failures newContent diffs+ NewContent successes failures newContent | successes == 0 && failures == 0 -> do putStrLn $ fileName ++ ": No conflicts, git-adding"@@ -216,7 +213,7 @@ putStrLn $ concat [ fileName, ": Failed to resolve any of the " , show failures, " conflicts" ]- dumpAndOpenEditor colorEnable opts fileName diffs+ doDump | otherwise -> do putStrLn $ concat@@ -230,7 +227,14 @@ removeFile bkup if failures == 0 then gitAdd fileName- else dumpAndOpenEditor colorEnable opts fileName diffs+ else doDump+ where+ doDump =+ dumpAndOpenEditor colorEnable opts fileName $+ [ cDiff+ | Right conflict <- parseConflicts newContent+ , cDiff <- getConflictDiffs conflict+ ] stripNewline :: String -> String stripNewline x@@ -281,6 +285,20 @@ , "specified in your per-project .git/config?" ] +relativePath :: FilePath -> FilePath -> FilePath+relativePath base path+ | rel /= path = rel+ | revRel /= base =+ joinPath $ replicate (length (splitPath revRel)) ".."+ | otherwise = path+ where+ rel = makeRelative base path+ revRel = makeRelative path base++(</>) :: FilePath -> FilePath -> FilePath+"." </> p = p+d </> p = d FilePath.</> p+ main :: IO () main = do opts <- getOpts =<< getArgs@@ -293,6 +311,9 @@ statusPorcelain <- readProcess "git" ["status", "--porcelain"] stdin let rootRelativeFileNames = mapMaybe (unprefix "UU ") $ lines statusPorcelain- rootDir <- stripNewline <$> readProcess "git" ["rev-parse", "--show-toplevel"] stdin+ cwd <- getCurrentDirectory+ rootDir <-+ relativePath cwd . stripNewline <$>+ readProcess "git" ["rev-parse", "--show-toplevel"] stdin mapM_ (resolve colorEnable opts . (rootDir </>)) rootRelativeFileNames