diff options
Diffstat (limited to 'Git/LsFiles.hs')
| -rw-r--r-- | Git/LsFiles.hs | 80 |
1 files changed, 79 insertions, 1 deletions
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 06d4b9f44..321913334 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -1,6 +1,6 @@ {- git ls-files interface - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010,2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,11 +13,16 @@ module Git.LsFiles ( changedUnstaged, typeChanged, typeChangedStaged, + Conflicting(..), + Unmerged(..), + unmerged, ) where import Common import Git import Git.Command +import Git.Types +import Git.Sha {- Scans for files that are checked into git at the specified locations. -} inRepo :: [FilePath] -> Repo -> IO [FilePath] @@ -75,3 +80,76 @@ typeChanged' ps l repo = do where prefix = [Params "diff --name-only --diff-filter=T -z"] suffix = Param "--" : map File l + +{- A item in conflict has two possible values. + - Either can be Nothing, when that side deleted the file. -} +data Conflicting v = Conflicting + { valUs :: Maybe v + , valThem :: Maybe v + } deriving (Show) + +data Unmerged = Unmerged + { unmergedFile :: FilePath + , unmergedBlobType :: Conflicting BlobType + , unmergedSha :: Conflicting Sha + } deriving (Show) + +{- Returns a list of the files in the specified locations that have + - unresolved merge conflicts. + - + - ls-files outputs multiple lines per conflicting file, each with its own + - stage number: + - 1 = old version, can be ignored + - 2 = us + - 3 = them + - If a line is omitted, that side deleted the file. + -} +unmerged :: [FilePath] -> Repo -> IO [Unmerged] +unmerged l repo = reduceUnmerged [] . catMaybes . map parseUnmerged <$> list repo + where + files = map File l + list = pipeNullSplit $ Params "ls-files --unmerged -z --" : files + +data InternalUnmerged = InternalUnmerged + { isus :: Bool + , ifile :: FilePath + , iblobtype :: Maybe BlobType + , isha :: Maybe Sha + } deriving (Show) + +parseUnmerged :: String -> Maybe InternalUnmerged +parseUnmerged s + | null file || length ws < 3 = Nothing + | otherwise = do + stage <- readish (ws !! 2) :: Maybe Int + unless (stage == 2 || stage == 3) $ + fail undefined -- skip stage 1 + blobtype <- readBlobType (ws !! 0) + sha <- extractSha (ws !! 1) + return $ InternalUnmerged (stage == 2) file (Just blobtype) (Just sha) + where + (metadata, file) = separate (== '\t') s + ws = words metadata + +reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged] +reduceUnmerged c [] = c +reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest + where + (rest, sibi) = findsib i is + (blobtypeA, blobtypeB, shaA, shaB) + | isus i = (iblobtype i, iblobtype sibi, isha i, isha sibi) + | otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i) + new = Unmerged + { unmergedFile = ifile i + , unmergedBlobType = Conflicting blobtypeA blobtypeB + , unmergedSha = Conflicting shaA shaB + } + findsib templatei [] = ([], deleted templatei) + findsib templatei (l:ls) + | ifile l == ifile templatei = (ls, l) + | otherwise = (l:ls, deleted templatei) + deleted templatei = templatei + { isus = not (isus templatei) + , iblobtype = Nothing + , isha = Nothing + } |