diff options
Diffstat (limited to 'Git/LsFiles.hs')
-rw-r--r-- | Git/LsFiles.hs | 88 |
1 files changed, 72 insertions, 16 deletions
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 540503a28..ce7c84aee 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -13,6 +13,9 @@ module Git.LsFiles ( changedUnstaged, typeChanged, typeChangedStaged, + Conflicting(..), + Unmerged(..), + unmerged, ) where import Common @@ -78,25 +81,78 @@ typeChanged' ps l repo = do 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) + +isConflicting :: Eq a => Conflicting a -> Bool +isConflicting (Conflicting a b) = a /= b + data Unmerged = Unmerged { unmergedFile :: FilePath - , unmergedBlobType :: BlobType - , unmergedSha :: Sha - } + , unmergedBlobType :: Conflicting BlobType + , unmergedSha :: Conflicting Sha + } deriving (Show) {- Returns a list of the files in the specified locations that have - - unresolved merge conflicts. Each unmerged file will have duplicates - - in the list for each unmerged version (typically two). -} + - 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 = catMaybes . map parse <$> list repo +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) + 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 - list = pipeNullSplit $ Params "ls-files --unmerged -z --" : map File l - parse s - | null file || length ws < 2 = Nothing - | otherwise = do - blobtype <- readBlobType (ws !! 0) - sha <- extractSha (ws !! 1) - return $ Unmerged file blobtype sha - where - (metadata, file) = separate (== '\t') s - ws = words metadata + (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 (i:is) + | ifile i == ifile templatei = (is, i) + | otherwise = (i:is, deleted templatei) + deleted templatei = templatei + { isus = not (isus templatei) + , iblobtype = Nothing + , isha = Nothing + } |