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 :: String -> [CommandParam] -> [FilePath] -> Annex ()
addCommand command params files = do addCommand command params files = do
q <- get 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. -} {- Adds an update-index stream to the queue. -}
addUpdateIndex :: Git.UpdateIndex.Streamer -> Annex () addUpdateIndex :: Git.UpdateIndex.Streamer -> Annex ()
addUpdateIndex streamer = do addUpdateIndex streamer = do
q <- get 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. -} {- Runs the queue if it is full. -}
flushWhenFull :: Annex () flushWhenFull :: Git.Queue.Queue -> Annex Git.Queue.Queue
flushWhenFull = do flushWhenFull q
q <- get | Git.Queue.full q = flush' q
when (Git.Queue.full q) flush | otherwise = return q
{- Runs (and empties) the queue. -} {- Runs (and empties) the queue. -}
flush :: Annex () flush :: Annex ()
flush = do flush = do
q <- get q <- get
unless (0 == Git.Queue.size q) $ do unless (0 == Git.Queue.size q) $ do
store =<< flush' q
flush' :: Git.Queue.Queue -> Annex Git.Queue.Queue
flush' q = do
showStoringStateAction showStoringStateAction
q' <- inRepo $ Git.Queue.flush q inRepo $ Git.Queue.flush q
store q'
{- Gets the size of the queue. -} {- Gets the size of the queue. -}
size :: Annex Int size :: Annex Int
@ -70,5 +75,4 @@ mergeFrom st = case repoqueue st of
Just newq -> do Just newq -> do
q <- get q <- get
let !q' = Git.Queue.merge q newq let !q' = Git.Queue.merge q newq
store q' store =<< flushWhenFull q'
flushWhenFull

View file

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

View file

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

View file

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

View file

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