aboutsummaryrefslogtreecommitdiff
path: root/Annex/Queue.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-01-13 14:55:01 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-01-13 14:55:01 -0400
commit3b72782586f5f6872d00891f6b46f5a8cb654e7a (patch)
treeeedcc18e399d06aa77c6637264d7bad3836fe94b /Annex/Queue.hs
parentc747c8e423afe272dcf045abf3f1e8c1f6985e5c (diff)
immediate queue flushing when annex.queuesize=1
Previously, it only flushed when the queue got larger than 1. Also, make the queue auto-flush when items are added, rather than needing to be flushed as a separate step. This simplifies the code and make it more efficient too, as it avoids needing to read the queue out of the state to check if it should be flushed.
Diffstat (limited to 'Annex/Queue.hs')
-rw-r--r--Annex/Queue.hs28
1 files changed, 16 insertions, 12 deletions
diff --git a/Annex/Queue.hs b/Annex/Queue.hs
index 136e36093..d4cab48ca 100644
--- a/Annex/Queue.hs
+++ b/Annex/Queue.hs
@@ -25,28 +25,33 @@ import qualified Git.UpdateIndex
addCommand :: String -> [CommandParam] -> [FilePath] -> Annex ()
addCommand command params files = do
q <- get
- store <=< inRepo $ Git.Queue.addCommand command params files q
+ store <=< flushWhenFull <=< inRepo $
+ Git.Queue.addCommand command params files q
{- Adds an update-index stream to the queue. -}
addUpdateIndex :: Git.UpdateIndex.Streamer -> Annex ()
addUpdateIndex streamer = do
q <- get
- store <=< inRepo $ Git.Queue.addUpdateIndex streamer q
+ store <=< flushWhenFull <=< inRepo $
+ Git.Queue.addUpdateIndex streamer q
-{- Runs the queue if it is full. Should be called periodically. -}
-flushWhenFull :: Annex ()
-flushWhenFull = do
- q <- get
- when (Git.Queue.full q) flush
+{- Runs the queue if it is full. -}
+flushWhenFull :: Git.Queue.Queue -> Annex Git.Queue.Queue
+flushWhenFull q
+ | Git.Queue.full q = flush' q
+ | otherwise = return q
{- Runs (and empties) the queue. -}
flush :: Annex ()
flush = do
q <- get
unless (0 == Git.Queue.size q) $ do
- showStoringStateAction
- q' <- inRepo $ Git.Queue.flush q
- store q'
+ store =<< flush' q
+
+flush' :: Git.Queue.Queue -> Annex Git.Queue.Queue
+flush' q = do
+ showStoringStateAction
+ inRepo $ Git.Queue.flush q
{- Gets the size of the queue. -}
size :: Annex Int
@@ -70,5 +75,4 @@ mergeFrom st = case repoqueue st of
Just newq -> do
q <- get
let !q' = Git.Queue.merge q newq
- store q'
- flushWhenFull
+ store =<< flushWhenFull q'