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.

5 files changed, 21 insertions, 23 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'
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index d10f929d0..1fc20a906 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -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. -}
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 2579196c9..03acb04d7 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -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
diff --git a/Git/Queue.hs b/Git/Queue.hs
index 23533a14d..086b5a56f 100644
--- a/Git/Queue.hs
+++ b/Git/Queue.hs
@@ -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
diff --git a/doc/bugs/addurl_--batch__--with-files_doesn__39__t_add_file_into_git_until_pipe_is_closed.mdwn b/doc/bugs/addurl_--batch__--with-files_doesn__39__t_add_file_into_git_until_pipe_is_closed.mdwn
index 46534587d..59dda810f 100644
--- a/doc/bugs/addurl_--batch__--with-files_doesn__39__t_add_file_into_git_until_pipe_is_closed.mdwn
+++ b/doc/bugs/addurl_--batch__--with-files_doesn__39__t_add_file_into_git_until_pipe_is_closed.mdwn
@@ -94,3 +94,5 @@ git-annex version: 6.20160104+gitg0cf96be-1~ndall+1
 """]]
 
 [[!meta author=yoh]]
+
+> closing as not a bug [[done]] --[[Joey]]