diff options
| -rw-r--r-- | Annex/Queue.hs | 2 | ||||
| -rw-r--r-- | Git/Queue.hs | 28 |
2 files changed, 20 insertions, 10 deletions
diff --git a/Annex/Queue.hs b/Annex/Queue.hs index 24575e906..d4a2c592e 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 b8055ab44..956e9adb1 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -1,6 +1,6 @@ {- git repository command queue - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010,2012 Joey Hess <joey@kitenet.net> - - 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 |