From 06a1f5f74286795708b219de8fb080077ff134a7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 29 Jun 2011 11:55:16 -0400 Subject: [PATCH] factor out file list stuff from GitRepo GitRepo is getting too large an interface; these all fit nicely into a submodule. --- Command.hs | 15 +++++----- Command/Unannex.hs | 3 +- Command/Unused.hs | 3 +- GitRepo.hs | 56 -------------------------------------- GitRepo/LsFiles.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++++ Upgrade/V1.hs | 3 +- 6 files changed, 82 insertions(+), 66 deletions(-) create mode 100644 GitRepo/LsFiles.hs diff --git a/Command.hs b/Command.hs index a8cc6a132a..45a4cc70fd 100644 --- a/Command.hs +++ b/Command.hs @@ -22,6 +22,7 @@ import qualified Backend import Messages import qualified Annex import qualified GitRepo as Git +import qualified GitRepo.LsFiles as LsFiles import Utility import Types.Key @@ -118,17 +119,17 @@ notBareRepo a = do withFilesInGit :: CommandSeekStrings withFilesInGit a params = do repo <- Annex.gitRepo - files <- liftIO $ runPreserveOrder (Git.inRepo repo) params + files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params liftM (map a) $ filterFiles files withAttrFilesInGit :: String -> CommandSeekAttrFiles withAttrFilesInGit attr a params = do 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 withBackendFilesInGit :: CommandSeekBackendFiles withBackendFilesInGit a params = do repo <- Annex.gitRepo - files <- liftIO $ runPreserveOrder (Git.inRepo repo) params + files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params files' <- filterFiles files backendPairs a files' withFilesMissing :: CommandSeekStrings @@ -143,7 +144,7 @@ withFilesNotInGit :: CommandSeekBackendFiles withFilesNotInGit a params = do repo <- Annex.gitRepo force <- Annex.getState Annex.force - newfiles <- liftIO $ runPreserveOrder (Git.notInRepo repo force) params + newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params newfiles' <- filterFiles newfiles backendPairs a newfiles' withWords :: CommandSeekWords @@ -153,12 +154,12 @@ withStrings a params = return $ map a params withFilesToBeCommitted :: CommandSeekStrings withFilesToBeCommitted a params = do repo <- Annex.gitRepo - tocommit <- liftIO $ runPreserveOrder (Git.stagedFilesNotDeleted repo) params + tocommit <- liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params liftM (map a) $ filterFiles tocommit withFilesUnlocked :: CommandSeekBackendFiles -withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles +withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles -withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles +withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles withFilesUnlocked' typechanged a params = do -- unlocked files have changed type from a symlink to a regular file diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 0a5381d562..0de98b1d3f 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -20,6 +20,7 @@ import LocationLog import Types import Content import qualified GitRepo as Git +import qualified GitRepo.LsFiles as LsFiles import Messages command :: [Command] @@ -37,7 +38,7 @@ start file = isAnnexed file $ \(key, backend) -> do force <- Annex.getState Annex.force unless force $ do g <- Annex.gitRepo - staged <- liftIO $ Git.stagedFiles g [Git.workTree g] + staged <- liftIO $ LsFiles.staged g [Git.workTree g] unless (null staged) $ error "This command cannot be run when there are already files staged for commit." Annex.changeState $ \s -> s { Annex.force = True } diff --git a/Command/Unused.hs b/Command/Unused.hs index 5744f84fd4..c0a3471796 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -23,6 +23,7 @@ import Utility import LocationLog import qualified Annex import qualified GitRepo as Git +import qualified GitRepo.LsFiles as LsFiles import qualified Backend import qualified Remote @@ -175,7 +176,7 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller getKeysReferenced :: Annex [Key] getKeysReferenced = do g <- Annex.gitRepo - files <- liftIO $ Git.inRepo g [Git.workTree g] + files <- liftIO $ LsFiles.inRepo g [Git.workTree g] keypairs <- mapM Backend.lookupFile files return $ map fst $ catMaybes keypairs diff --git a/GitRepo.hs b/GitRepo.hs index cfe949d5e6..cc4636868d 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -47,16 +47,9 @@ module GitRepo ( remotesAdd, repoRemoteName, repoRemoteNameSet, - inRepo, - notInRepo, - stagedFiles, - stagedFilesNotDeleted, - changedUnstagedFiles, checkAttr, decodeGitFile, encodeGitFile, - typeChangedFiles, - typeChangedStagedFiles, repoAbsPath, reap, useIndex, @@ -432,55 +425,6 @@ getSha subcommand a = do shaSize :: Int 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 - parameter), and splits it into a list of files/lines/whatever. -} pipeNullSplit :: Repo -> [CommandParam] -> IO [FilePath] diff --git a/GitRepo/LsFiles.hs b/GitRepo/LsFiles.hs new file mode 100644 index 0000000000..16604c319a --- /dev/null +++ b/GitRepo/LsFiles.hs @@ -0,0 +1,68 @@ +{- git ls-files interface + - + - Copyright 2010 Joey Hess + - + - 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 diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index b06f00d34d..cb6928fcee 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -26,6 +26,7 @@ import LocationLog import qualified Annex import qualified AnnexQueue import qualified GitRepo as Git +import qualified GitRepo.LsFiles as LsFiles import Backend import Messages import Version @@ -92,7 +93,7 @@ updateSymlinks :: Annex () updateSymlinks = do showNote "updating symlinks..." g <- Annex.gitRepo - files <- liftIO $ Git.inRepo g [Git.workTree g] + files <- liftIO $ LsFiles.inRepo g [Git.workTree g] forM_ files $ fixlink where fixlink f = do