got rid of several more calls to git when finding unlocked files

This commit is contained in:
Joey Hess 2010-11-11 18:21:54 -04:00
parent ce62f5abf1
commit f2c7a6e73d
3 changed files with 28 additions and 28 deletions

View file

@ -10,6 +10,7 @@ module CmdLine (parseCmd) where
import System.Console.GetOpt
import Control.Monad.State (liftIO)
import System.Directory
import System.Posix.Files
import Control.Monad (filterM, when)
import qualified GitRepo as Git
@ -17,7 +18,6 @@ import qualified Annex
import Locations
import qualified Backend
import Types
import Core
import Command
import qualified Command.Add
@ -138,8 +138,11 @@ withFilesNotInGit a params = do
backendPairs a $ foldl (++) [] newfiles
withFilesUnlocked :: SubCmdSeekBackendFiles
withFilesUnlocked a params = do
unlocked <- mapM unlockedFiles params
backendPairs a $ foldl (++) [] unlocked
-- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo
typechangedfiles <- liftIO $ mapM (Git.typeChangedFiles repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
backendPairs a $ filter notState unlockedfiles
backendPairs :: SubCmdSeekBackendFiles
backendPairs a files = do
pairs <- Backend.chooseBackends files
@ -154,10 +157,9 @@ withFilesToBeCommitted a params = do
withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
withUnlockedFilesToBeCommitted a params = do
repo <- Annex.gitRepo
unlocked <- mapM unlockedFiles params
tocommit <- liftIO $ mapM (Git.stagedFiles repo) $
filter notState $ foldl (++) [] unlocked
return $ map a $ foldl (++) [] tocommit
typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
return $ map a $ filter notState unlockedfiles
withKeys :: SubCmdSeekStrings
withKeys a params = return $ map a params
withTempFile :: SubCmdSeekStrings
@ -169,6 +171,12 @@ withNothing a _ = return [a]
notState :: FilePath -> Bool
notState f = stateLoc /= take (length stateLoc) f
{- filter out symlinks -}
notSymlink :: FilePath -> IO Bool
notSymlink f = do
s <- liftIO $ getSymbolicLinkStatus f
return $ not $ isSymbolicLink s
{- Parses command line and returns two lists of actions to be
- run in the Annex monad. The first actions configure it
- according to command line options, while the second actions

14
Core.hs
View file

@ -224,20 +224,6 @@ getKeysReferenced = do
keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs
{- Passed a location (a directory or a single file, returns
- files there that are unlocked for editing. -}
unlockedFiles :: FilePath -> Annex [FilePath]
unlockedFiles l = do
-- unlocked files have changed type from a symlink to a regular file
g <- Annex.gitRepo
typechangedfiles <- liftIO $ Git.typeChangedFiles g l
unlockedfiles <- filterM notsymlink typechangedfiles
return unlockedfiles
where
notsymlink f = do
s <- liftIO $ getSymbolicLinkStatus f
return $ not $ isSymbolicLink s
{- Uses the annex.version git config setting to automate upgrades. -}
autoUpgrade :: Annex ()
autoUpgrade = do

View file

@ -40,6 +40,7 @@ module GitRepo (
decodeGitFile,
encodeGitFile,
typeChangedFiles,
typeChangedStagedFiles,
prop_idempotent_deencode
) where
@ -59,7 +60,6 @@ import Data.Char
import Data.Word (Word8)
import Codec.Binary.UTF8.String (encode)
import Text.Printf
import Data.List
import Utility
@ -244,17 +244,23 @@ stagedFiles repo l = pipeNullSplit repo
["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z",
"--", l]
{- Passed a location, returns a list of the files whose type has changed. -}
{- Passed a location, returns a list of the files, staged for
- commit, whose type has changed. -}
typeChangedStagedFiles :: Repo -> FilePath -> IO [FilePath]
typeChangedStagedFiles repo l = typeChangedFiles' repo l ["--cached"]
{- Passed a location, returns a list of the files whose type has changed.
- Files only staged for commit will not be included. -}
typeChangedFiles :: Repo -> FilePath -> IO [FilePath]
typeChangedFiles repo l = do
changed <- pipeNullSplit repo $ start ++ end
changedCached <- pipeNullSplit repo $ start ++ ["--cached"] ++ end
-- a file can be found twice by the above, so nub
return $ nub $ changed ++ changedCached
typeChangedFiles repo l = typeChangedFiles' repo l []
typeChangedFiles' :: Repo -> FilePath -> [String] -> IO [FilePath]
typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
where
start = ["diff", "--name-only", "--diff-filter=T", "-z"]
end = ["--", l]
{- Reads null terminated output of a git command (as enabled by the -z
- parameter), and splits it into a list of files. -}
pipeNullSplit :: Repo -> [String] -> IO [FilePath]