factor out file list stuff from GitRepo

GitRepo is getting too large an interface; these all fit nicely into a
submodule.
This commit is contained in:
Joey Hess 2011-06-29 11:55:16 -04:00
parent af45d42224
commit 06a1f5f742
6 changed files with 82 additions and 66 deletions

View file

@ -22,6 +22,7 @@ import qualified Backend
import Messages import Messages
import qualified Annex import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitRepo.LsFiles as LsFiles
import Utility import Utility
import Types.Key import Types.Key
@ -118,17 +119,17 @@ notBareRepo a = do
withFilesInGit :: CommandSeekStrings withFilesInGit :: CommandSeekStrings
withFilesInGit a params = do withFilesInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
liftM (map a) $ filterFiles files liftM (map a) $ filterFiles files
withAttrFilesInGit :: String -> CommandSeekAttrFiles withAttrFilesInGit :: String -> CommandSeekAttrFiles
withAttrFilesInGit attr a params = do withAttrFilesInGit attr a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
liftM (map a) $ liftIO $ Git.checkAttr repo attr files liftM (map a) $ liftIO $ Git.checkAttr repo attr files
withBackendFilesInGit :: CommandSeekBackendFiles withBackendFilesInGit :: CommandSeekBackendFiles
withBackendFilesInGit a params = do withBackendFilesInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
files' <- filterFiles files files' <- filterFiles files
backendPairs a files' backendPairs a files'
withFilesMissing :: CommandSeekStrings withFilesMissing :: CommandSeekStrings
@ -143,7 +144,7 @@ withFilesNotInGit :: CommandSeekBackendFiles
withFilesNotInGit a params = do withFilesNotInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
force <- Annex.getState Annex.force force <- Annex.getState Annex.force
newfiles <- liftIO $ runPreserveOrder (Git.notInRepo repo force) params newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
newfiles' <- filterFiles newfiles newfiles' <- filterFiles newfiles
backendPairs a newfiles' backendPairs a newfiles'
withWords :: CommandSeekWords withWords :: CommandSeekWords
@ -153,12 +154,12 @@ withStrings a params = return $ map a params
withFilesToBeCommitted :: CommandSeekStrings withFilesToBeCommitted :: CommandSeekStrings
withFilesToBeCommitted a params = do withFilesToBeCommitted a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
tocommit <- liftIO $ runPreserveOrder (Git.stagedFilesNotDeleted repo) params tocommit <- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
liftM (map a) $ filterFiles tocommit liftM (map a) $ filterFiles tocommit
withFilesUnlocked :: CommandSeekBackendFiles withFilesUnlocked :: CommandSeekBackendFiles
withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles
withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles
withFilesUnlocked' typechanged a params = do withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file -- unlocked files have changed type from a symlink to a regular file

View file

@ -20,6 +20,7 @@ import LocationLog
import Types import Types
import Content import Content
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitRepo.LsFiles as LsFiles
import Messages import Messages
command :: [Command] command :: [Command]
@ -37,7 +38,7 @@ start file = isAnnexed file $ \(key, backend) -> do
force <- Annex.getState Annex.force force <- Annex.getState Annex.force
unless force $ do unless force $ do
g <- Annex.gitRepo g <- Annex.gitRepo
staged <- liftIO $ Git.stagedFiles g [Git.workTree g] staged <- liftIO $ LsFiles.staged g [Git.workTree g]
unless (null staged) $ unless (null staged) $
error "This command cannot be run when there are already files staged for commit." error "This command cannot be run when there are already files staged for commit."
Annex.changeState $ \s -> s { Annex.force = True } Annex.changeState $ \s -> s { Annex.force = True }

View file

@ -23,6 +23,7 @@ import Utility
import LocationLog import LocationLog
import qualified Annex import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitRepo.LsFiles as LsFiles
import qualified Backend import qualified Backend
import qualified Remote import qualified Remote
@ -175,7 +176,7 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
getKeysReferenced :: Annex [Key] getKeysReferenced :: Annex [Key]
getKeysReferenced = do getKeysReferenced = do
g <- Annex.gitRepo g <- Annex.gitRepo
files <- liftIO $ Git.inRepo g [Git.workTree g] files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
keypairs <- mapM Backend.lookupFile files keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs return $ map fst $ catMaybes keypairs

View file

@ -47,16 +47,9 @@ module GitRepo (
remotesAdd, remotesAdd,
repoRemoteName, repoRemoteName,
repoRemoteNameSet, repoRemoteNameSet,
inRepo,
notInRepo,
stagedFiles,
stagedFilesNotDeleted,
changedUnstagedFiles,
checkAttr, checkAttr,
decodeGitFile, decodeGitFile,
encodeGitFile, encodeGitFile,
typeChangedFiles,
typeChangedStagedFiles,
repoAbsPath, repoAbsPath,
reap, reap,
useIndex, useIndex,
@ -432,55 +425,6 @@ getSha subcommand a = do
shaSize :: Int shaSize :: Int
shaSize = 40 shaSize = 40
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: Repo -> [FilePath] -> IO [FilePath]
inRepo repo l = pipeNullSplit repo $
[Params "ls-files --cached -z --"] ++ map File l
{- Scans for files at the specified locations that are not checked into
- git. -}
notInRepo :: Repo -> Bool -> [FilePath] -> IO [FilePath]
notInRepo repo include_ignored l =
pipeNullSplit repo $ [Params "ls-files --others"]++exclude++[Params "-z --"] ++ map File l
where
exclude = if include_ignored then [] else [Param "--exclude-standard"]
{- Returns a list of all files that are staged for commit. -}
stagedFiles :: Repo -> [FilePath] -> IO [FilePath]
stagedFiles repo l = stagedFiles' repo l []
{- Returns a list of the files, staged for commit, that are being added,
- moved, or changed (but not deleted), from the specified locations. -}
stagedFilesNotDeleted :: Repo -> [FilePath] -> IO [FilePath]
stagedFilesNotDeleted repo l = stagedFiles' repo l [Param "--diff-filter=ACMRT"]
stagedFiles' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
stagedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
where
start = [Params "diff --cached --name-only -z"]
end = [Param "--"] ++ map File l
{- Returns a list of files that have unstaged changes. -}
changedUnstagedFiles :: Repo -> [FilePath] -> IO [FilePath]
changedUnstagedFiles repo l = pipeNullSplit repo $
[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. -}
typeChangedStagedFiles :: Repo -> [FilePath] -> IO [FilePath]
typeChangedStagedFiles repo l = typeChangedFiles' repo l [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. -}
typeChangedFiles :: Repo -> [FilePath] -> IO [FilePath]
typeChangedFiles repo l = typeChangedFiles' repo l []
typeChangedFiles' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
where
start = [Params "diff --name-only --diff-filter=T -z"]
end = [Param "--"] ++ map File l
{- Reads null terminated output of a git command (as enabled by the -z {- Reads null terminated output of a git command (as enabled by the -z
- parameter), and splits it into a list of files/lines/whatever. -} - parameter), and splits it into a list of files/lines/whatever. -}
pipeNullSplit :: Repo -> [CommandParam] -> IO [FilePath] pipeNullSplit :: Repo -> [CommandParam] -> IO [FilePath]

68
GitRepo/LsFiles.hs Normal file
View file

@ -0,0 +1,68 @@
{- git ls-files interface
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module GitRepo.LsFiles (
inRepo,
notInRepo,
staged,
stagedNotDeleted,
changedUnstaged,
typeChanged,
typeChangedStaged,
) where
import GitRepo
import Utility
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: Repo -> [FilePath] -> IO [FilePath]
inRepo repo l = pipeNullSplit repo $
[Params "ls-files --cached -z --"] ++ map File l
{- Scans for files at the specified locations that are not checked into
- git. -}
notInRepo :: Repo -> Bool -> [FilePath] -> IO [FilePath]
notInRepo repo include_ignored l =
pipeNullSplit repo $ [Params "ls-files --others"]++exclude++[Params "-z --"] ++ map File l
where
exclude = if include_ignored then [] else [Param "--exclude-standard"]
{- Returns a list of all files that are staged for commit. -}
staged :: Repo -> [FilePath] -> IO [FilePath]
staged repo l = staged' repo l []
{- Returns a list of the files, staged for commit, that are being added,
- moved, or changed (but not deleted), from the specified locations. -}
stagedNotDeleted :: Repo -> [FilePath] -> IO [FilePath]
stagedNotDeleted repo l = staged' repo l [Param "--diff-filter=ACMRT"]
staged' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
staged' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
where
start = [Params "diff --cached --name-only -z"]
end = [Param "--"] ++ map File l
{- Returns a list of files that have unstaged changes. -}
changedUnstaged :: Repo -> [FilePath] -> IO [FilePath]
changedUnstaged repo l = pipeNullSplit repo $
[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 :: Repo -> [FilePath] -> IO [FilePath]
typeChangedStaged repo l = typeChanged' repo l [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 :: Repo -> [FilePath] -> IO [FilePath]
typeChanged repo l = typeChanged' repo l []
typeChanged' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
typeChanged' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
where
start = [Params "diff --name-only --diff-filter=T -z"]
end = [Param "--"] ++ map File l

View file

@ -26,6 +26,7 @@ import LocationLog
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitRepo.LsFiles as LsFiles
import Backend import Backend
import Messages import Messages
import Version import Version
@ -92,7 +93,7 @@ updateSymlinks :: Annex ()
updateSymlinks = do updateSymlinks = do
showNote "updating symlinks..." showNote "updating symlinks..."
g <- Annex.gitRepo g <- Annex.gitRepo
files <- liftIO $ Git.inRepo g [Git.workTree g] files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
forM_ files $ fixlink forM_ files $ fixlink
where where
fixlink f = do fixlink f = do