From 92e5d28ca83d057a3d8f5d7d30806642de699172 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 28 Nov 2010 14:19:43 -0400 Subject: [PATCH] precommit: Optimise to avoid calling git-check-attr more than once. --- Command.hs | 32 ++++++++++++++++---------------- Command/Add.hs | 2 +- Command/PreCommit.hs | 14 ++++++-------- Command/Unlock.hs | 1 - debian/changelog | 6 ++++++ 5 files changed, 29 insertions(+), 26 deletions(-) diff --git a/Command.hs b/Command.hs index 4d10a9e7f1..7f3063abb9 100644 --- a/Command.hs +++ b/Command.hs @@ -41,8 +41,9 @@ type SubCmdCleanup = Annex Bool - functions. -} type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek type SubCmdStartString = String -> SubCmdStart +type BackendFile = (FilePath, Maybe Backend) type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek -type SubCmdStartBackendFile = (FilePath, Maybe Backend) -> SubCmdStart +type SubCmdStartBackendFile = BackendFile -> SubCmdStart type SubCmdSeekNothing = SubCmdStart -> SubCmdSeek type SubCmdStartNothing = SubCmdStart @@ -116,17 +117,6 @@ withFilesNotInGit a params = do repo <- Annex.gitRepo newfiles <- liftIO $ mapM (Git.notInRepo repo) params backendPairs a $ filter notState $ foldl (++) [] newfiles -withFilesUnlocked :: SubCmdSeekBackendFiles -withFilesUnlocked a params = do - -- 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 - return $ map a pairs withString :: SubCmdSeekStrings withString a params = return [a $ unwords params] withStrings :: SubCmdSeekStrings @@ -136,12 +126,17 @@ withFilesToBeCommitted a params = do repo <- Annex.gitRepo tocommit <- liftIO $ mapM (Git.stagedFiles repo) params return $ map a $ filter notState $ foldl (++) [] tocommit -withUnlockedFilesToBeCommitted :: SubCmdSeekStrings -withUnlockedFilesToBeCommitted a params = do +withFilesUnlocked :: SubCmdSeekBackendFiles +withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles +withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles +withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles +withFilesUnlocked' :: (Git.Repo -> FilePath -> IO [FilePath]) -> SubCmdSeekBackendFiles +withFilesUnlocked' typechanged a params = do + -- unlocked files have changed type from a symlink to a regular file repo <- Annex.gitRepo - typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params + typechangedfiles <- liftIO $ mapM (typechanged repo) params unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles - return $ map a $ filter notState unlockedfiles + backendPairs a $ filter notState unlockedfiles withKeys :: SubCmdSeekStrings withKeys a params = return $ map a params withTempFile :: SubCmdSeekStrings @@ -150,6 +145,11 @@ withNothing :: SubCmdSeekNothing withNothing a [] = return [a] withNothing _ _ = return [] +backendPairs :: SubCmdSeekBackendFiles +backendPairs a files = do + pairs <- Backend.chooseBackends files + return $ map a pairs + {- Default to acting on all files matching the seek action if - none are specified. -} withAll :: SubCmdSeekStrings -> SubCmdSeekStrings diff --git a/Command/Add.hs b/Command/Add.hs index cf32a8d641..d141448a3a 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -34,7 +34,7 @@ start pair@(file, _) = notAnnexed file $ do showStart "add" file return $ Just $ perform pair -perform :: (FilePath, Maybe Backend) -> SubCmdPerform +perform :: BackendFile -> SubCmdPerform perform (file, backend) = do stored <- Backend.storeFileKey file backend case stored of diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index d4e5c04b9c..513d5d43f7 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -11,7 +11,6 @@ import Control.Monad.State (liftIO) import Command import qualified Annex -import qualified Backend import qualified GitRepo as Git import qualified Command.Add import qualified Command.Fix @@ -20,15 +19,14 @@ import qualified Command.Fix - And, it needs to inject unlocked files into the annex. -} seek :: [SubCmdSeek] seek = [withFilesToBeCommitted Command.Fix.start, - withUnlockedFilesToBeCommitted start] + withFilesUnlockedToBeCommitted start] -start :: SubCmdStartString -start file = return $ Just $ perform file +start :: SubCmdStartBackendFile +start pair = return $ Just $ perform pair -perform :: FilePath -> SubCmdPerform -perform file = do - pairs <- Backend.chooseBackends [file] - ok <- doSubCmd $ Command.Add.start $ head pairs +perform :: BackendFile -> SubCmdPerform +perform pair@(file, _) = do + ok <- doSubCmd $ Command.Add.start pair if ok then return $ Just $ cleanup file else error $ "failed to add " ++ file ++ "; canceling commit" diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 34fde819cb..ff22fa84b3 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -15,7 +15,6 @@ import qualified Annex import Types import Messages import Locations -import Utility import Core import CopyFile diff --git a/debian/changelog b/debian/changelog index 8ab14d64c5..808087dadc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +git-annex (0.10) UNRELEASED; urgency=low + + * precommit: Optimise to avoid calling git-check-attr more than once. + + -- Joey Hess Sun, 28 Nov 2010 14:19:15 -0400 + git-annex (0.09) unstable; urgency=low * Add copy subcommand.