summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-04 20:41:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-04 20:41:22 -0400
commit7a6fb8ae4e455ea311213da50cc5e8cd6d5667b2 (patch)
tree7b4f8545b70fe8e18fa0eabbd7542fdf397eac7b
parentbd7857d903a602bc5f1d5e01f0b936bb5b41b5c6 (diff)
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.
-rw-r--r--Annex/Queue.hs2
-rw-r--r--Git/Queue.hs28
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