diff options
-rw-r--r-- | CmdLine.hs | 22 | ||||
-rw-r--r-- | Core.hs | 14 | ||||
-rw-r--r-- | GitRepo.hs | 20 |
3 files changed, 28 insertions, 28 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index 7c9d75c18..5c25b41c3 100644 --- a/CmdLine.hs +++ b/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 @@ -168,6 +170,12 @@ withNothing a _ = return [a] {- filter out files from the state directory -} 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 @@ -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 diff --git a/GitRepo.hs b/GitRepo.hs index 5fc077c44..fa78e5122 100644 --- a/GitRepo.hs +++ b/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,16 +244,22 @@ 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. -} |