diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-06-27 09:27:59 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-06-27 09:27:59 -0400 |
| commit | 8e8439a5191e8768edebdcf27668157b70c0ebf7 (patch) | |
| tree | b90e08855ff83a24d03f376712daeb92b932bef0 | |
| parent | 6f45827fe07262f93f39ae420f4362bfa0246194 (diff) | |
add ls-files --unmerged support
| -rw-r--r-- | Git/LsFiles.hs | 27 | ||||
| -rw-r--r-- | Git/Types.hs | 6 |
2 files changed, 32 insertions, 1 deletions
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 06d4b9f44..540503a28 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. -} @@ -18,6 +18,8 @@ module Git.LsFiles ( 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 +77,26 @@ typeChanged' ps l repo = do where prefix = [Params "diff --name-only --diff-filter=T -z"] suffix = Param "--" : map File l + +data Unmerged = Unmerged + { unmergedFile :: FilePath + , unmergedBlobType :: BlobType + , unmergedSha :: Sha + } + +{- 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). -} +unmerged :: [FilePath] -> Repo -> IO [Unmerged] +unmerged l repo = catMaybes . map parse <$> list repo + 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 diff --git a/Git/Types.hs b/Git/Types.hs index 1df6e343b..e8cdbb442 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -71,3 +71,9 @@ instance Show BlobType where show FileBlob = "100644" show ExecutableBlob = "100755" show SymlinkBlob = "120000" + +readBlobType :: String -> Maybe BlobType +readBlobType "100644" = Just FileBlob +readBlobType "100755" = Just ExecutableBlob +readBlobType "120000" = Just SymlinkBlob +readBlobType _ = Nothing |