extend Git.Queue to be able to queue more than simple git commands

While I was in there, I noticed and fixed a bug in the queue size
calculations. It was never encountered only because Queue.add was
only ever run with 1 file in the list.

Annex/Queue.hs

@@ -6,7 +6,7 @@
  -}
 
 module Annex.Queue (
-	add,
+	addCommand,
 	flush,
 	flushWhenFull
 ) where
@@ -17,10 +17,10 @@ import qualified Git.Queue
 import Config
 
 {- Adds a git command to the queue. -}
-add :: String -> [CommandParam] -> [FilePath] -> Annex ()
-add command params files = do
+addCommand :: String -> [CommandParam] -> [FilePath] -> Annex ()
+addCommand command params files = do
 	q <- get
-	store =<< inRepo (Git.Queue.add q command params files)
+	store =<< inRepo (Git.Queue.addCommand command params files q)
 
 {- Runs the queue if it is full. Should be called periodically. -}
 flushWhenFull :: Annex ()

Command/Add.hs

@@ -121,5 +121,5 @@ cleanup file key hascontent = do
 		( return [Param "-f"]
 		, return []
 		)
-	Annex.Queue.add "add" (params++[Param "--"]) [file]
+	Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
 	return True

Command/Fix.hs

@@ -36,5 +36,5 @@ perform file link = do
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do
-	Annex.Queue.add "add" [Param "--force", Param "--"] [file]
+	Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
 	return True

Command/FromKey.hs

@@ -39,5 +39,5 @@ perform key file = do
 
 cleanup :: FilePath -> CommandCleanup
 cleanup file = do
-	Annex.Queue.add "add" [Param "--"] [file]
+	Annex.Queue.addCommand "add" [Param "--"] [file]
 	return True

Command/Fsck.hs

@@ -155,7 +155,7 @@ fixLink key file = do
 		liftIO $ createDirectoryIfMissing True (parentDir file)
 		liftIO $ removeFile file
 		liftIO $ createSymbolicLink want file
-		Annex.Queue.add "add" [Param "--force", Param "--"] [file]
+		Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
 	return True
 
 {- Checks that the location log reflects the current status of the key,

Command/Lock.hs

@@ -24,5 +24,5 @@ start file = do
 
 perform :: FilePath -> CommandPerform
 perform file = do
-	Annex.Queue.add "checkout" [Param "--"] [file]
+	Annex.Queue.addCommand "checkout" [Param "--"] [file]
 	next $ return True -- no cleanup needed

Git/Queue.hs

@@ -10,7 +10,8 @@
 module Git.Queue (
 	Queue,
 	new,
-	add,
+	addCommand,
+	addUpdateIndex,
 	size,
 	full,
 	flush,
@@ -25,19 +26,31 @@ import Utility.SafeCommand
 import Common
 import Git
 import Git.Command
+import qualified Git.UpdateIndex
 	
-{- An action to perform in a git repository. The file to act on
- - is not included, and must be able to be appended after the params. -}
-data Action = Action
+{- Queable actions that can be performed in a git repository.
+ -}
+data Action
+	{- Updating the index file, using a list of streamers that can
+	 - be added to as the queue grows. -}
+	= UpdateIndexAction
+		{ getStreamers :: [Git.UpdateIndex.Streamer]
+		}
+	{- A git command to run, on a list of files that can be added to
+	 - as the queue grows. -}
+	| CommandAction 
 		{ getSubcommand :: String
 		, getParams :: [CommandParam]
-	} deriving (Show, Eq, Ord)
+		, getFiles :: [FilePath]
+		} 
 
-{- Compares two actions by subcommand. -}
-(===) :: Action -> Action -> Bool
-a === b = getSubcommand a == getSubcommand b
-(/==) :: Action -> Action -> Bool
-a /== b = not $ a === b
+{- A key that can uniquely represent an action in a Map. -}
+data ActionKey = UpdateIndexActionKey | CommandActionKey String
+	deriving (Eq, Ord)
+
+actionKey :: Action -> ActionKey
+actionKey (UpdateIndexAction _) = UpdateIndexActionKey
+actionKey CommandAction { getSubcommand = s } = CommandActionKey s
 
 {- A queue of actions to perform (in any order) on a git repository,
  - with lists of files to perform them on. This allows coalescing 
@@ -45,9 +58,8 @@ a /== b = not $ a === b
 data Queue = Queue
 	{ size :: Int
 	, _limit :: Int
-	, _items :: M.Map Action [FilePath]
+	, items :: M.Map ActionKey Action
 	}
-	deriving (Show, Eq)
 
 {- A recommended maximum size for the queue, after which it should be
  - run.
@@ -65,20 +77,58 @@ defaultLimit = 10240
 new :: Maybe Int -> Queue
 new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty
 
-{- Adds an action to a queue. If the queue already contains a different
+{- Adds a command to a queue. If the queue already contains a different
  - action, it will be flushed; this is to ensure that conflicting actions,
- - like add and rm, are run in the right order. -}
-add :: Queue -> String -> [CommandParam] -> [FilePath] -> Repo -> IO Queue
-add q@(Queue _ _ m) subcommand params files repo
-	| null (filter (/== action) (M.keys m)) = go q
-	| otherwise = go =<< flush q repo
+ - like add and rm, are run in the right order. 
+ -
+ - Actions with the same subcommand but different parameters are
+ - roughly equivilant; assumed equivilant enough to perform in any order
+ - with the same result.
+ -}
+addCommand :: String -> [CommandParam] -> [FilePath] -> Queue -> Repo -> IO Queue
+addCommand subcommand params files q repo =
+	updateQueue action different (length newfiles) q repo
 	where
-		action = Action subcommand params
-		go (Queue cur lim m') =
-			return $ Queue (cur + 1) lim $
-				M.insertWith' const action fs m'
+		key = actionKey action
+		action = CommandAction
+			{ getSubcommand = subcommand
+			, getParams = params
+			, getFiles = newfiles
+			}
+		newfiles = files ++ maybe [] getFiles (M.lookup key $ items q)
+		
+		different (CommandAction { getSubcommand = s }) = s /= subcommand
+		different _ = True
+
+addUpdateIndex :: Git.UpdateIndex.Streamer -> Queue -> Repo -> IO Queue
+addUpdateIndex streamer q repo =
+	updateQueue action different 0 q repo
 	where
-				!fs = files ++ M.findWithDefault [] action m'
+		key = actionKey action
+		-- streamer is added to the end of the list, since
+		-- order does matter for update-index input
+		action = UpdateIndexAction $ streamers ++ [streamer]
+		streamers = maybe [] getStreamers $ M.lookup key $ items q
+
+		different (UpdateIndexAction _) = False
+		different _ = True
+
+{- Updates or adds an action in the queue. If the queue already contains a
+ - different action, it will be flushed; this is to ensure that conflicting
+ - actions, like add and rm, are run in the right order.-}
+updateQueue :: Action -> (Action -> Bool) -> Int -> Queue -> Repo -> IO Queue
+updateQueue action different sizeincrease q repo
+	| null (filter different (M.elems (items q))) = return $ go q
+	| otherwise = go <$> flush q repo
+	where
+		go q' = newq
+			where		
+				!newq = q'
+					{ size = newsize
+					, items = newitems
+					}
+				!newsize = size q' + sizeincrease
+				!newitems = M.insertWith' const (actionKey action) action (items q')
 
 {- Is a queue large enough that it should be flushed? -}
 full :: Queue -> Bool
@@ -87,7 +137,7 @@ full (Queue cur lim  _) = cur > lim
 {- Runs a queue on a git repository. -}
 flush :: Queue -> Repo -> IO Queue
 flush (Queue _ lim m) repo = do
-	forM_ (M.toList m) $ uncurry $ runAction repo
+	forM_ (M.elems m) $ runAction repo
 	return $ Queue 0 lim M.empty
 
 {- Runs an Action on a list of files in a git repository.
@@ -96,12 +146,13 @@ flush (Queue _ lim m) repo = do
  -
  - Intentionally runs the command even if the list of files is empty;
  - this allows queueing commands that do not need a list of files. -}
-runAction :: Repo -> Action -> [FilePath] -> IO ()
-runAction repo action files =
+runAction :: Repo -> Action -> IO ()
+runAction _repo _action@(UpdateIndexAction {}) = error "TODO"
+runAction repo action@(CommandAction {}) =
 	pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs
 	where
 		params = toCommand $ gitCommandLine
 			(Param (getSubcommand action):getParams action) repo
 		feedxargs h = do
 			fileEncoding h
-			hPutStr h $ join "\0" files
+			hPutStr h $ join "\0" $ getFiles action

Upgrade/V1.hs

@@ -94,7 +94,7 @@ updateSymlinks = do
 					link <- calcGitLink f k
 					liftIO $ removeFile f
 					liftIO $ createSymbolicLink link f
-					Annex.Queue.add "add" [Param "--"] [f]
+					Annex.Queue.addCommand "add" [Param "--"] [f]
 
 moveLocationLogs :: Annex ()
 moveLocationLogs = do
@@ -121,9 +121,9 @@ moveLocationLogs = do
 				old <- liftIO $ readLog1 f
 				new <- liftIO $ readLog1 dest
 				liftIO $ writeLog1 dest (old++new)
-				Annex.Queue.add "add" [Param "--"] [dest]
-				Annex.Queue.add "add" [Param "--"] [f]
-				Annex.Queue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f]
+				Annex.Queue.addCommand "add" [Param "--"] [dest]
+				Annex.Queue.addCommand "add" [Param "--"] [f]
+				Annex.Queue.addCommand "rm" [Param "--quiet", Param "-f", Param "--"] [f]
 		
 oldlog2key :: FilePath -> Maybe (FilePath, Key)
 oldlog2key l