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 System.Console.GetOpt
 | 
				
			||||||
import Control.Monad.State (liftIO)
 | 
					import Control.Monad.State (liftIO)
 | 
				
			||||||
import System.Directory
 | 
					import System.Directory
 | 
				
			||||||
 | 
					import System.Posix.Files
 | 
				
			||||||
import Control.Monad (filterM, when)
 | 
					import Control.Monad (filterM, when)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import qualified GitRepo as Git
 | 
					import qualified GitRepo as Git
 | 
				
			||||||
| 
						 | 
					@ -17,7 +18,6 @@ import qualified Annex
 | 
				
			||||||
import Locations
 | 
					import Locations
 | 
				
			||||||
import qualified Backend
 | 
					import qualified Backend
 | 
				
			||||||
import Types
 | 
					import Types
 | 
				
			||||||
import Core
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Command
 | 
					import Command
 | 
				
			||||||
import qualified Command.Add
 | 
					import qualified Command.Add
 | 
				
			||||||
| 
						 | 
					@ -138,8 +138,11 @@ withFilesNotInGit a params = do
 | 
				
			||||||
	backendPairs a $ foldl (++) [] newfiles
 | 
						backendPairs a $ foldl (++) [] newfiles
 | 
				
			||||||
withFilesUnlocked :: SubCmdSeekBackendFiles
 | 
					withFilesUnlocked :: SubCmdSeekBackendFiles
 | 
				
			||||||
withFilesUnlocked a params = do
 | 
					withFilesUnlocked a params = do
 | 
				
			||||||
	unlocked <- mapM unlockedFiles params
 | 
						-- unlocked files have changed type from a symlink to a regular file
 | 
				
			||||||
	backendPairs a $ foldl (++) [] unlocked
 | 
						repo <- Annex.gitRepo
 | 
				
			||||||
 | 
						typechangedfiles <- liftIO $ mapM (Git.typeChangedFiles repo) params
 | 
				
			||||||
 | 
						unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
 | 
				
			||||||
 | 
						backendPairs a $ filter notState unlockedfiles
 | 
				
			||||||
backendPairs :: SubCmdSeekBackendFiles
 | 
					backendPairs :: SubCmdSeekBackendFiles
 | 
				
			||||||
backendPairs a files = do
 | 
					backendPairs a files = do
 | 
				
			||||||
	pairs <- Backend.chooseBackends files
 | 
						pairs <- Backend.chooseBackends files
 | 
				
			||||||
| 
						 | 
					@ -154,10 +157,9 @@ withFilesToBeCommitted a params = do
 | 
				
			||||||
withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
 | 
					withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
 | 
				
			||||||
withUnlockedFilesToBeCommitted a params = do
 | 
					withUnlockedFilesToBeCommitted a params = do
 | 
				
			||||||
	repo <- Annex.gitRepo
 | 
						repo <- Annex.gitRepo
 | 
				
			||||||
	unlocked <- mapM unlockedFiles params
 | 
						typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params
 | 
				
			||||||
	tocommit <- liftIO $ mapM (Git.stagedFiles repo) $
 | 
						unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
 | 
				
			||||||
		filter notState $ foldl (++) [] unlocked
 | 
						return $ map a $ filter notState unlockedfiles
 | 
				
			||||||
	return $ map a $ foldl (++) [] tocommit
 | 
					 | 
				
			||||||
withKeys :: SubCmdSeekStrings
 | 
					withKeys :: SubCmdSeekStrings
 | 
				
			||||||
withKeys a params = return $ map a params
 | 
					withKeys a params = return $ map a params
 | 
				
			||||||
withTempFile :: SubCmdSeekStrings
 | 
					withTempFile :: SubCmdSeekStrings
 | 
				
			||||||
| 
						 | 
					@ -168,6 +170,12 @@ withNothing a _ = return [a]
 | 
				
			||||||
{- filter out files from the state directory -}
 | 
					{- filter out files from the state directory -}
 | 
				
			||||||
notState :: FilePath -> Bool
 | 
					notState :: FilePath -> Bool
 | 
				
			||||||
notState f = stateLoc /= take (length stateLoc) f
 | 
					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 
 | 
					{- Parses command line and returns two lists of actions to be 
 | 
				
			||||||
 - run in the Annex monad. The first actions configure it
 | 
					 - run in the Annex monad. The first actions configure it
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										14
									
								
								Core.hs
									
										
									
									
									
								
							
							
						
						
									
										14
									
								
								Core.hs
									
										
									
									
									
								
							| 
						 | 
					@ -224,20 +224,6 @@ getKeysReferenced = do
 | 
				
			||||||
	keypairs <- mapM Backend.lookupFile files
 | 
						keypairs <- mapM Backend.lookupFile files
 | 
				
			||||||
	return $ map fst $ catMaybes keypairs
 | 
						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. -}
 | 
					{- Uses the annex.version git config setting to automate upgrades. -}
 | 
				
			||||||
autoUpgrade :: Annex ()
 | 
					autoUpgrade :: Annex ()
 | 
				
			||||||
autoUpgrade = do
 | 
					autoUpgrade = do
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										20
									
								
								GitRepo.hs
									
										
									
									
									
								
							
							
						
						
									
										20
									
								
								GitRepo.hs
									
										
									
									
									
								
							| 
						 | 
					@ -40,6 +40,7 @@ module GitRepo (
 | 
				
			||||||
	decodeGitFile,
 | 
						decodeGitFile,
 | 
				
			||||||
	encodeGitFile,
 | 
						encodeGitFile,
 | 
				
			||||||
	typeChangedFiles,
 | 
						typeChangedFiles,
 | 
				
			||||||
 | 
						typeChangedStagedFiles,
 | 
				
			||||||
 | 
					
 | 
				
			||||||
	prop_idempotent_deencode
 | 
						prop_idempotent_deencode
 | 
				
			||||||
) where
 | 
					) where
 | 
				
			||||||
| 
						 | 
					@ -59,7 +60,6 @@ import Data.Char
 | 
				
			||||||
import Data.Word (Word8)
 | 
					import Data.Word (Word8)
 | 
				
			||||||
import Codec.Binary.UTF8.String (encode)
 | 
					import Codec.Binary.UTF8.String (encode)
 | 
				
			||||||
import Text.Printf
 | 
					import Text.Printf
 | 
				
			||||||
import Data.List
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Utility
 | 
					import Utility
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -244,16 +244,22 @@ stagedFiles repo l = pipeNullSplit repo
 | 
				
			||||||
	["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z", 
 | 
						["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z", 
 | 
				
			||||||
		"--", l]
 | 
							"--", 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 -> FilePath -> IO [FilePath]
 | 
				
			||||||
typeChangedFiles repo l = do
 | 
					typeChangedFiles repo l = typeChangedFiles' repo l []
 | 
				
			||||||
	changed <- pipeNullSplit repo $ start ++ end
 | 
					
 | 
				
			||||||
	changedCached <- pipeNullSplit repo $ start ++ ["--cached"] ++ end
 | 
					typeChangedFiles' :: Repo -> FilePath -> [String] -> IO [FilePath]
 | 
				
			||||||
	-- a file can be found twice by the above, so nub
 | 
					typeChangedFiles' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 | 
				
			||||||
	return $ nub $ changed ++ changedCached
 | 
					 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		start = ["diff", "--name-only", "--diff-filter=T", "-z"]
 | 
							start = ["diff", "--name-only", "--diff-filter=T", "-z"]
 | 
				
			||||||
		end = ["--", l]
 | 
							end = ["--", 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. -}
 | 
					 - parameter), and splits it into a list of files. -}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue