got rid of several more calls to git when finding unlocked files
This commit is contained in:
parent
ce62f5abf1
commit
f2c7a6e73d
3 changed files with 28 additions and 28 deletions
22
CmdLine.hs
22
CmdLine.hs
|
@ -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
14
Core.hs
|
@ -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
|
||||
|
|
20
GitRepo.hs
20
GitRepo.hs
|
@ -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]
|
||||
|
|
Loading…
Reference in a new issue