git-annex-3.20121112: Git/LsFiles.hs

{- git ls-files interface
 -
 - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Git.LsFiles (
	inRepo,
	notInRepo,
	staged,
	stagedNotDeleted,
	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], IO Bool)
inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l

{- Scans for files at the specified locations that are not checked into git. -}
notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
notInRepo include_ignored l repo = pipeNullSplit params repo
	where
		params = [Params "ls-files --others"] ++ exclude ++
			[Params "-z --"] ++ map File l
		exclude
			| include_ignored = []
			| otherwise = [Param "--exclude-standard"]

{- Returns a list of all files that are staged for commit. -}
staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged = staged' []

{- Returns a list of the files, staged for commit, that are being added,
 - moved, or changed (but not deleted), from the specified locations. -}
stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]

staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
	where
		prefix = [Params "diff --cached --name-only -z"]
		suffix = Param "--" : map File l

{- Returns a list of files that have unstaged changes. -}
changedUnstaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
changedUnstaged l = pipeNullSplit params
	where
		params = Params "diff --name-only -z --" : map File l

{- Returns a list of the files in the specified locations that are staged
 - for commit, and whose type has changed. -}
typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChangedStaged = typeChanged' [Param "--cached"]

{- Returns a list of the files in the specified locations whose type has
 - changed.  Files only staged for commit will not be included. -}
typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChanged = typeChanged' []

typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChanged' ps l repo = do
	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
	-- git diff returns filenames relative to the top of the git repo;
	-- convert to filenames relative to the cwd, like git ls-files.
	let top = repoPath repo
	cwd <- getCurrentDirectory
	return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup)
	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], IO Bool)
unmerged l repo = do
	(fs, cleanup) <- pipeNullSplit params repo
	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
	where
		params = Params "ls-files --unmerged -z --" : map File l

data InternalUnmerged = InternalUnmerged
	{ isus :: Bool
	, ifile :: FilePath
	, iblobtype :: Maybe BlobType
	, isha :: Maybe Sha
	} deriving (Show)

parseUnmerged :: String -> Maybe InternalUnmerged
parseUnmerged s
	| null file = Nothing
	| otherwise = case words metadata of
		(rawblobtype:rawsha:rawstage:_) -> do
			stage <- readish rawstage :: Maybe Int
			unless (stage == 2 || stage == 3) $
				fail undefined -- skip stage 1
			blobtype <- readBlobType rawblobtype
			sha <- extractSha rawsha
			return $ InternalUnmerged (stage == 2) file
				(Just blobtype) (Just sha)
		_ -> Nothing
	where
		(metadata, file) = separate (== '\t') s

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
			}