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.
This commit is contained in:
Joey Hess 2016-01-13 14:55:01 -04:00
parent 1d5b70db9c
commit b52cf5697b
Failed to extract signature
5 changed files with 21 additions and 23 deletions

View file

@ -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'

View file

@ -195,11 +195,7 @@ runHandler handler file filestatus = void $ do
case r of
Left e -> liftIO $ warningIO $ show e
Right Nothing -> noop
Right (Just change) -> do
-- Just in case the commit thread is not
-- flushing the queue fast enough.
liftAnnex Annex.Queue.flushWhenFull
recordChange change
Right (Just change) -> recordChange change
where
normalize f
| "./" `isPrefixOf` file = drop 2 f
@ -391,7 +387,6 @@ onDelDir dir _ = do
recordChanges $ map (\f -> Change now f RmChange) fs
void $ liftIO clean
liftAnnex Annex.Queue.flushWhenFull
noChange
{- Called when there's an error with inotify or kqueue. -}

View file

@ -119,11 +119,8 @@ findFreeSlot = go []
{- Like commandAction, but without the concurrency. -}
includeCommandAction :: CommandStart -> CommandCleanup
includeCommandAction a = account =<< tryIO go
includeCommandAction a = account =<< tryIO (callCommandAction a)
where
go = do
Annex.Queue.flushWhenFull
callCommandAction a
account (Right True) = return True
account (Right False) = incerr
account (Left err) = do

View file

@ -137,7 +137,7 @@ merge origq newq = origq
{- Is a queue large enough that it should be flushed? -}
full :: Queue -> Bool
full (Queue cur lim _) = cur > lim
full (Queue cur lim _) = cur >= lim
{- Runs a queue on a git repository. -}
flush :: Queue -> Repo -> IO Queue

View file

@ -94,3 +94,5 @@ git-annex version: 6.20160104+gitg0cf96be-1~ndall+1
"""]]
[[!meta author=yoh]]
> closing as not a bug [[done]] --[[Joey]]