diff --git a/resolve-trivial-conflicts.cabal b/resolve-trivial-conflicts.cabal --- a/resolve-trivial-conflicts.cabal +++ b/resolve-trivial-conflicts.cabal @@ -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 diff --git a/resolve_trivial_conflicts.hs b/resolve_trivial_conflicts.hs --- a/resolve_trivial_conflicts.hs +++ b/resolve_trivial_conflicts.hs @@ -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