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:
parent
af45d42224
commit
06a1f5f742
6 changed files with 82 additions and 66 deletions
15
Command.hs
15
Command.hs
|
@ -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
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
56
GitRepo.hs
56
GitRepo.hs
|
@ -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
68
GitRepo/LsFiles.hs
Normal 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
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue