assistant: Fix bug that caused it to stall when adding a very large number of files at once (around 5 thousand).

This bug was introduced in 74c30fc1a6e88d926d07e12f4e7ffc7d897bf9f6,
which improved handling of adding very large numbers of files by ensuring
that a minimum number of max size commits (5000 files each) were done.

I accidentially made it wait for another change to appear after such a max
size commit, even if a lot of queued changes were already accumulated.
That resulted in a stall when it got to the end. Now fixed to not wait
any longer than necessary to ensure the watcher has had time to wake back
up after the max size commit.

This commit was sponsored by Michael Linksvayer. Thanks!

1 files changed, 18 insertions, 10 deletions

diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index d1fa7224e..e069bda21 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -75,33 +75,38 @@ refill cs = do
 	debug ["delaying commit of", show (length cs), "changes"]
 	refillChanges cs
 
-{- Wait for one or more changes to arrive to be committed. -}
+{- Wait for one or more changes to arrive to be committed, and then
+ - runs an action to commit them. If more changes arrive while this is
+ - going on, they're handled intelligently, batching up changes into
+ - large commits where possible, doing rename detection, and
+ - commiting immediately otherwise. -}
 waitChangeTime :: (([Change], UTCTime) -> Assistant Int) -> Assistant ()
-waitChangeTime a = go [] 0
+waitChangeTime a = waitchanges 0
   where
-	go unhandled lastcommitsize = do
+	waitchanges lastcommitsize = do
 		-- Wait one one second as a simple rate limiter.
 		liftIO $ threadDelaySeconds (Seconds 1)
 		-- Now, wait until at least one change is available for
 		-- processing.
 		cs <- getChanges
-		let changes = unhandled ++ cs
+		handlechanges cs lastcommitsize
+	handlechanges changes lastcommitsize = do
 		let len = length changes
 		-- See if now's a good time to commit.
 		now <- liftIO getCurrentTime
 		case (lastcommitsize >= maxCommitSize, shouldCommit now len changes, possiblyrename changes) of
 			(True, True, _)
 				| len > maxCommitSize -> 
-					go [] =<< a (changes, now)
+					waitchanges =<< a (changes, now)
 				| otherwise -> aftermaxcommit changes
 			(_, True, False) ->
-				go [] =<< a (changes, now)
+				waitchanges =<< a (changes, now)
 			(_, True, True) -> do
 				morechanges <- getrelatedchanges changes
-				go [] =<< a (changes ++ morechanges, now)
+				waitchanges =<< a (changes ++ morechanges, now)
 			_ -> do
 				refill changes
-				go [] lastcommitsize
+				waitchanges lastcommitsize
 	
 	{- Did we perhaps only get one of the AddChange and RmChange pair
 	 - that make up a file rename? Or some of the pairs that make up 
@@ -158,14 +163,17 @@ waitChangeTime a = go [] 0
 	 -}
 	aftermaxcommit oldchanges = loop (30 :: Int)
 	  where
-	  	loop 0 = go oldchanges 0
+	  	loop 0 = continue oldchanges
 	  	loop n = do
 			liftAnnex noop -- ensure Annex state is free
 			liftIO $ threadDelaySeconds (Seconds 1)
 			changes <- getAnyChanges
 			if null changes
 				then loop (n - 1)
-				else go (oldchanges ++ changes) 0
+				else continue (oldchanges ++ changes)
+		continue cs
+			| null cs = waitchanges 0
+			| otherwise = handlechanges cs 0
 
 isRmChange :: Change -> Bool
 isRmChange (Change { changeInfo = i }) | i == RmChange = True