diff options
| -rw-r--r-- | Annex.hs | 8 | ||||
| -rw-r--r-- | CmdLine.hs | 2 | ||||
| -rw-r--r-- | GitQueue.hs | 17 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 25 |
4 files changed, 34 insertions, 18 deletions
@@ -16,6 +16,7 @@ module Annex ( gitRepo, queue, queueRun, + queueRunAt, setConfig, repoConfig ) where @@ -109,6 +110,13 @@ queueRun = do liftIO $ GitQueue.run g q put state { repoqueue = GitQueue.empty } +{- Runs the queue if the specified number of items have been queued. -} +queueRunAt :: Integer -> Annex () +queueRunAt n = do + state <- get + let q = repoqueue state + when (GitQueue.size q >= n) queueRun + {- Changes a git config setting in both internal state and .git/config -} setConfig :: String -> String -> Annex () setConfig k value = do diff --git a/CmdLine.hs b/CmdLine.hs index b8fd6af7c..0698f2f5e 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -99,7 +99,7 @@ startup = do shutdown :: Annex Bool shutdown = do q <- Annex.getState Annex.repoqueue - unless (q == GitQueue.empty) $ do + unless (0 == GitQueue.size q) $ do showSideAction "Recording state in git..." Annex.queueRun diff --git a/GitQueue.hs b/GitQueue.hs index 07cf9f62f..097516c19 100644 --- a/GitQueue.hs +++ b/GitQueue.hs @@ -9,6 +9,7 @@ module GitQueue ( Queue, empty, add, + size, run ) where @@ -31,22 +32,28 @@ data Action = Action { {- A queue of actions to perform (in any order) on a git repository, - with lists of files to perform them on. This allows coalescing - similar git commands. -} -type Queue = M.Map Action [FilePath] +data Queue = Queue Integer (M.Map Action [FilePath]) + deriving (Show, Eq) {- Constructor for empty queue. -} empty :: Queue -empty = M.empty +empty = Queue 0 M.empty {- Adds an action to a queue. -} add :: Queue -> String -> [CommandParam] -> FilePath -> Queue -add queue subcommand params file = M.insertWith (++) action [file] queue +add (Queue n m) subcommand params file = Queue (n + 1) m' where action = Action subcommand params + m' = M.insertWith' (++) action [file] m + +{- Number of items in a queue. -} +size :: Queue -> Integer +size (Queue n _) = n {- Runs a queue on a git repository. -} run :: Git.Repo -> Queue -> IO () -run repo queue = do - forM_ (M.toList queue) $ uncurry $ runAction repo +run repo (Queue _ m) = do + forM_ (M.toList m) $ uncurry $ runAction repo return () {- Runs an Action on a list of files in a git repository. diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 1bf3cc0e8..64ca298eb 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -66,9 +66,10 @@ upgrade = do updateSymlinks moveLocationLogs + Annex.queueRun + -- add new line to auto-merge hashed location logs -- this commits, so has to come after the upgrade - g <- Annex.gitRepo liftIO $ Command.Init.gitAttributesWrite g setVersion @@ -92,18 +93,18 @@ updateSymlinks :: Annex () updateSymlinks = do g <- Annex.gitRepo files <- liftIO $ Git.inRepo g [Git.workTree g] - forM_ files $ (fixlink g) + forM_ files $ fixlink where - fixlink g f = do + fixlink f = do r <- lookupFile1 f case r of Nothing -> return () Just (k, _) -> do link <- calcGitLink f k - liftIO $ do - removeFile f - createSymbolicLink link f - Git.run g "add" [Param "--", File f] + liftIO $ removeFile f + liftIO $ createSymbolicLink link f + Annex.queue "add" [Param "--"] f + Annex.queueRunAt 1024 moveLocationLogs :: Annex () moveLocationLogs = do @@ -127,11 +128,11 @@ moveLocationLogs = do -- logs that have been pulled from elsewhere old <- liftIO $ readLog f new <- liftIO $ readLog dest - liftIO $ do - writeLog dest (old++new) - Git.run g "add" [Param "--", File dest] - Git.run g "add" [Param "--", File f] - Git.run g "rm" [Param "--quiet", Param "-f", Param "--", File f] + liftIO $ writeLog dest (old++new) + Annex.queue "add" [Param "--"] dest + Annex.queue "add" [Param "--"] f + Annex.queue "rm" [Param "--quiet", Param "-f", Param "--"] f + Annex.queueRunAt 1024 oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key l = |