resolve-trivial-conflicts 0.2.0.2 → 0.3
raw patch · 2 files changed
+99/−49 lines, 2 filesdep ~Diffdep ~ansi-terminaldep ~base
Dependency ranges changed: Diff, ansi-terminal, base, directory, filepath, mtl, process, unix
Files
resolve-trivial-conflicts.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: resolve-trivial-conflicts-version: 0.2.0.2+version: 0.3 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@@ -24,13 +24,13 @@ main-is: resolve_trivial_conflicts.hs other-modules: PPDiff -- other-extensions:- build-depends: base >=4.6 && <4.8- , mtl >=2.1 && <2.3- , directory ==1.2.*- , process ==1.2.*- , filepath ==1.3.*- , unix ==2.7.*- , Diff >=0.3 && <0.4- , ansi-terminal >=0.6.2 && <0.6.3+ build-depends: base >=4.6 && <5+ , mtl >=2.1+ , directory >=1.2+ , process >=1.2+ , filepath >=1.3+ , unix >=2.7+ , Diff >=0.3+ , ansi-terminal >=0.6.2 -- hs-source-dirs: default-language: Haskell2010
resolve_trivial_conflicts.hs view
@@ -1,18 +1,24 @@ {-# OPTIONS -O2 -Wall #-} {-# LANGUAGE FlexibleContexts, RecordWildCards #-} -import Control.Applicative-import Control.Monad.State-import Control.Monad.Writer-import Data.Algorithm.Diff (Diff, getDiff)-import Data.List-import PPDiff (ppDiff, ColorEnable(..))-import System.Directory (renameFile, removeFile)-import System.Environment (getProgName, getArgs, getEnv)-import System.FilePath-import System.Posix.IO (stdOutput)-import System.Posix.Terminal (queryTerminal)-import System.Process+import Control.Applicative ((<$>))+import qualified Control.Exception as E+import Control.Monad (when, unless)+import Control.Monad.State (MonadState, state, evalStateT)+import Control.Monad.Writer (runWriter, tell)+import Data.Algorithm.Diff (Diff, getDiff)+import Data.List (isPrefixOf, isSuffixOf)+import Data.Maybe (mapMaybe)+import Data.Monoid (Monoid(..))+import qualified Data.Monoid as Monoid+import PPDiff (ppDiff, ColorEnable(..))+import System.Directory (renameFile, removeFile)+import System.Environment (getProgName, getArgs, getEnv)+import System.Exit (ExitCode(..))+import System.FilePath ((<.>), (</>))+import System.Posix.IO (stdOutput)+import System.Posix.Terminal (queryTerminal)+import System.Process (callProcess, readProcess, readProcessWithExitCode) data Side = A | B deriving (Eq, Ord, Show)@@ -109,20 +115,20 @@ resolveContent :: [Either String Conflict] -> NewContent resolveContent = asResult . mconcat . map go where- asResult (Sum successes, Sum failures, newContent, diffs) = NewContent+ asResult (Monoid.Sum successes, Monoid.Sum failures, newContent, diffs) = NewContent { _resolvedSuccessfully = successes , _failedToResolve = failures , _newContent = newContent , _diffs = diffs }- go (Left line) = (Sum 0, Sum 0, unlines [line], [])+ go (Left line) = (Monoid.Sum 0, Monoid.Sum 0, unlines [line], []) go (Right conflict) = case resolveConflict conflict of Nothing ->- ( Sum 0, Sum 1, prettyConflict conflict+ ( Monoid.Sum 0, Monoid.Sum 1, prettyConflict conflict , getConflictDiffs conflict )- Just trivialLines -> (Sum 1, Sum 0, trivialLines, [])+ Just trivialLines -> (Monoid.Sum 1, Monoid.Sum 0, trivialLines, []) gitAdd :: FilePath -> IO () gitAdd fileName =@@ -132,14 +138,16 @@ { shouldUseEditor :: Bool , shouldDumpDiffs :: Bool , shouldUseColor :: Maybe ColorEnable+ , shouldSetConflictStyle :: Bool } instance Monoid Options where- mempty = Options False False Nothing- Options a0 b0 c0 `mappend` Options a1 b1 c1 =+ mempty = Options False False Nothing False+ Options oe0 od0 oc0 os0 `mappend` Options oe1 od1 oc1 os1 = Options- (combineBool a0 a1 "-e")- (combineBool b0 b1 "-d")- (combineMaybe c0 c1 "-c or -C")+ (combineBool oe0 oe1 "-e")+ (combineBool od0 od1 "-d")+ (combineMaybe oc0 oc1 "-c or -C")+ (os0 || os1) where err flag = error $ "Multiple " ++ flag ++ " flags used" combineMaybe (Just _) (Just _) flag = err flag@@ -149,6 +157,26 @@ combineBool True True flag = err flag combineBool x y _ = x || y +getOpts :: [String] -> IO Options+getOpts = fmap mconcat . mapM parseArg+ where+ parseArg "-e" = return mempty { shouldUseEditor = True }+ parseArg "-d" = return mempty { shouldDumpDiffs = True }+ parseArg "-c" = return mempty { shouldUseColor = Just EnableColor }+ parseArg "-C" = return mempty { shouldUseColor = Just DisableColor }+ parseArg "-s" = return mempty { shouldSetConflictStyle = True }+ parseArg _ =+ do prog <- getProgName+ fail $ unlines+ [ "Usage: " ++ prog ++ " [-e] [-d] [-c] [-C] [-s]"+ , ""+ , "-e Execute $EDITOR for each conflicted file that remains conflicted"+ , "-d Dump the left/right diffs from base in each conflict remaining"+ , "-c Enable color"+ , "-C Disable color"+ , "-s Configure git's global merge.conflictstyle to diff3 if needed"+ ]+ openEditor :: Options -> FilePath -> IO () openEditor opts path | shouldUseEditor opts =@@ -208,29 +236,50 @@ | "\n" `isSuffixOf` x = init x | otherwise = x -getOpts :: [String] -> IO Options-getOpts = fmap mconcat . mapM parseArg- where- parseArg "-e" = return mempty { shouldUseEditor = True }- parseArg "-d" = return mempty { shouldDumpDiffs = True }- parseArg "-c" = return mempty { shouldUseColor = Just EnableColor }- parseArg "-C" = return mempty { shouldUseColor = Just DisableColor }- parseArg _ =- do prog <- getProgName- fail $ unlines- [ "Usage: " ++ prog ++ " [-e] [-d] [-c]"- , ""- , "-e Execute $EDITOR for each conflicted file that remains conflicted"- , "-d Dump the left/right diffs from base in each conflict remaining"- , "-c Enable color"- , "-C Disable color"- ]- shouldUseColorByTerminal :: IO ColorEnable shouldUseColorByTerminal = do istty <- queryTerminal stdOutput return $ if istty then EnableColor else DisableColor +unprefix :: Eq a => [a] -> [a] -> Maybe [a]+unprefix prefix str+ | prefix `isPrefixOf` str = Just (drop (length prefix) str)+ | otherwise = Nothing++getConflictStyle :: IO String+getConflictStyle =+ do (exitCode, stdout, _) <- readProcessWithExitCode "git" ["config", "merge.conflictstyle"] stdin+ case exitCode of+ ExitSuccess -> return $ stripNewline stdout+ ExitFailure 1 -> return "unset"+ ExitFailure _ -> E.throwIO exitCode+ where+ stdin = ""++setConflictStyle :: IO ()+setConflictStyle =+ callProcess "git" ["config", "--global", "merge.conflictstyle", "diff3"]++checkConflictStyle :: Options -> IO ()+checkConflictStyle opts =+ do conflictStyle <- getConflictStyle+ when (conflictStyle /= "diff3") $+ do unless (shouldSetConflictStyle opts) $+ fail $ concat+ [ "merge.conflictstyle must be diff3 but is "+ , show conflictStyle+ , ". Use -s to automatically set it globally"+ ]+ setConflictStyle++ newConflictStyle <- getConflictStyle+ when (newConflictStyle /= "diff3") $+ fail $ concat+ [ "Attempt to set conflict style failed. Perhaps you have"+ , " an incorrect merge.conflictstyle configuration "+ , "specified in your per-project .git/config?"+ ]+ main :: IO () main = do opts <- getOpts =<< getArgs@@ -238,10 +287,11 @@ case shouldUseColor opts of Nothing -> shouldUseColorByTerminal Just colorEnable -> return colorEnable+ checkConflictStyle opts let stdin = "" statusPorcelain <- readProcess "git" ["status", "--porcelain"] stdin let rootRelativeFileNames =- map ((!! 1) . words) $ filter ("UU" `isPrefixOf`) $ lines statusPorcelain+ mapMaybe (unprefix "UU ") $ lines statusPorcelain rootDir <- stripNewline <$> readProcess "git" ["rev-parse", "--show-toplevel"] stdin mapM_ (resolve colorEnable opts . (rootDir </>)) rootRelativeFileNames