From 7a6fb8ae4e455ea311213da50cc5e8cd6d5667b2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 4 Jun 2012 20:41:22 -0400 Subject: [PATCH] flush the git queue when a new type of action is being added to it This allows the queue to be used in a single process for multiple possibly conflicting commands, like add and rm, without running them out of order. This assumes that running the same git subcommand with different parameters cannot itself conflict. --- Annex/Queue.hs | 2 +- Git/Queue.hs | 28 +++++++++++++++++++--------- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/Annex/Queue.hs b/Annex/Queue.hs index 24575e9068..d4a2c592e5 100644 --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -20,7 +20,7 @@ import Config add :: String -> [CommandParam] -> [FilePath] -> Annex () add command params files = do q <- get - store $ Git.Queue.add q command params files + store =<< inRepo (Git.Queue.add q command params files) {- Runs the queue if it is full. Should be called periodically. -} flushWhenFull :: Annex () diff --git a/Git/Queue.hs b/Git/Queue.hs index b8055ab445..956e9adb1d 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -1,6 +1,6 @@ {- git repository command queue - - - Copyright 2010 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -33,6 +33,12 @@ data Action = Action , getParams :: [CommandParam] } deriving (Show, Eq, Ord) +{- Compares two actions by subcommand. -} +(===) :: Action -> Action -> Bool +a === b = getSubcommand a == getSubcommand b +(/==) :: Action -> Action -> Bool +a /== b = not $ a === b + {- 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. -} @@ -59,16 +65,20 @@ defaultLimit = 10240 new :: Maybe Int -> Queue new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty -{- Adds an action to a queue. -} -add :: Queue -> String -> [CommandParam] -> [FilePath] -> Queue -add (Queue cur lim m) subcommand params files = Queue (cur + 1) lim m' +{- Adds an action to a queue. If the queue already contains a different + - action, it will be flushed; this is to ensure that conflicting actions, + - like add and rm, are run in the right order. -} +add :: Queue -> String -> [CommandParam] -> [FilePath] -> Repo -> IO Queue +add q@(Queue _ _ m) subcommand params files repo + | null (filter (/== action) (M.keys m)) = go q + | otherwise = go =<< flush q repo where action = Action subcommand params - -- There are probably few items in the map, but there - -- can be a lot of files per item. So, optimise adding - -- files. - m' = M.insertWith' const action fs m - !fs = files ++ M.findWithDefault [] action m + go (Queue cur lim m') = + return $ Queue (cur + 1) lim $ + M.insertWith' const action fs m' + where + !fs = files ++ M.findWithDefault [] action m' {- Is a queue large enough that it should be flushed? -} full :: Queue -> Bool