assistant: Fix deadlock that could occur when adding a lot of files at once in indirect mode.

This is a laziness problem. Despite the bang pattern on newfiles, the list
was not being fully evaluated before cleanup was called. Moving cleanup out
to after the list is actually used fixes this.

More evidence that I should be using ResourceT or pipes, if any was needed.

1 files changed, 7 insertions, 7 deletions

diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 5c7332ba6..d1fa7224e 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP, BangPatterns #-}
+{-# LANGUAGE CPP #-}
 
 module Assistant.Threads.Committer where
 
@@ -273,10 +273,11 @@ handleAdds :: Maybe Seconds -> [Change] -> Assistant [Change]
 handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	direct <- liftAnnex isDirect
-	pending' <- if direct
-		then return pending
+	(pending', cleanup) <- if direct
+		then return (pending, noop)
 		else findnew pending
 	(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
+	cleanup
 
 	unless (null postponed) $
 		refillChanges postponed
@@ -294,14 +295,13 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
   where
 	(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
 		
-	findnew [] = return []
+	findnew [] = return ([], noop)
 	findnew pending@(exemplar:_) = do
-		(!newfiles, cleanup) <- liftAnnex $
+		(newfiles, cleanup) <- liftAnnex $
 			inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
-		void $ liftIO cleanup
 		-- note: timestamp info is lost here
 		let ts = changeTime exemplar
-		return $ map (PendingAddChange ts) newfiles
+		return (map (PendingAddChange ts) newfiles, void $ liftIO $ cleanup)
 
 	returnWhen c a
 		| c = return otherchanges