Merge branch 'batchasync' into master

Annex.hs

@@ -112,7 +112,7 @@ data AnnexState = AnnexState
 	, backend :: Maybe (BackendA Annex)
 	, remotes :: [Types.Remote.RemoteA Annex]
 	, output :: MessageState
-	, concurrency :: Concurrency
+	, concurrency :: ConcurrencySetting
 	, force :: Bool
 	, fast :: Bool
 	, daemon :: Bool
@@ -171,7 +171,7 @@ newState c r = do
 		, backend = Nothing
 		, remotes = []
 		, output = o
-		, concurrency = NonConcurrent
+		, concurrency = ConcurrencyCmdLine NonConcurrent
 		, force = False
 		, fast = False
 		, daemon = False

Annex/Concurrent.hs

@@ -5,10 +5,14 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Annex.Concurrent where
+module Annex.Concurrent (
+	module Annex.Concurrent,
+	module Annex.Concurrent.Utility
+) where
 
 import Annex
 import Annex.Common
+import Annex.Concurrent.Utility
 import qualified Annex.Queue
 import Annex.Action
 import Types.Concurrency
@@ -22,19 +26,24 @@ import Control.Concurrent
 import Control.Concurrent.STM
 import qualified Data.Map as M
 
-setConcurrency :: Concurrency -> Annex ()
-setConcurrency NonConcurrent = Annex.changeState $ \s -> s 
-	{ Annex.concurrency = NonConcurrent
-	}
-setConcurrency c = do
-	cfh <- Annex.getState Annex.catfilehandles
+setConcurrency :: ConcurrencySetting -> Annex ()
+setConcurrency (ConcurrencyCmdLine s) = setConcurrency' s ConcurrencyCmdLine
+setConcurrency (ConcurrencyGitConfig s) = setConcurrency' s ConcurrencyGitConfig
+
+setConcurrency' :: Concurrency -> (Concurrency -> ConcurrencySetting) -> Annex ()
+setConcurrency' NonConcurrent f = 
+	Annex.changeState $ \s -> s 
+		{ Annex.concurrency = f NonConcurrent
+		}
+setConcurrency' c f = do
+	cfh <- getState Annex.catfilehandles
 	cfh' <- case cfh of
 		CatFileHandlesNonConcurrent _ -> liftIO catFileHandlesPool
 		CatFileHandlesPool _ -> pure cfh
 	cah <- mkConcurrentCheckAttrHandle c
 	cih <- mkConcurrentCheckIgnoreHandle c
 	Annex.changeState $ \s -> s
-		{ Annex.concurrency = c
+		{ Annex.concurrency = f c
 		, Annex.catfilehandles = cfh'
 		, Annex.checkattrhandle = Just cah
 		, Annex.checkignorehandle = Just cih
@@ -74,9 +83,9 @@ dupState = do
 	st <- Annex.getState id
 	-- Make sure that concurrency is enabled, if it was not already,
 	-- so the concurrency-safe resource pools are set up.
-	st' <- case Annex.concurrency st of
+	st' <- case getConcurrency' (Annex.concurrency st) of
 		NonConcurrent -> do
-			setConcurrency (Concurrent 1)
+			setConcurrency (ConcurrencyCmdLine (Concurrent 1))
 			Annex.getState id
 		_ -> return st
 	return $ st'

Annex/Concurrent/Utility.hs

@@ -7,10 +7,18 @@
 
 module Annex.Concurrent.Utility where
 
+import Annex
 import Types.Concurrency
 
 import GHC.Conc
 
+getConcurrency :: Annex Concurrency
+getConcurrency = getConcurrency' <$> getState concurrency
+
+getConcurrency' :: ConcurrencySetting -> Concurrency
+getConcurrency' (ConcurrencyCmdLine c) = c
+getConcurrency' (ConcurrencyGitConfig c) = c
+
 {- Honor the requested level of concurrency, but only up to the number of
  - CPU cores. Useful for things that are known to be CPU bound. -}
 concurrencyUpToCpus :: Concurrency -> IO Int

Annex/Drop.hs

@@ -47,8 +47,8 @@ type Reason = String
  - The runner is used to run CommandStart sequentially, it's typically 
  - callCommandAction.
  -}
-handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex ()
-handleDropsFrom locs rs reason fromhere key afile preverified runner = do
+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> SeekInput -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex ()
+handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
 	g <- Annex.gitRepo
 	l <- map (`fromTopFilePath` g)
 		<$> Database.Keys.getAssociatedFiles key
@@ -120,10 +120,10 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 
 	dropl fs n = checkdrop fs n Nothing $ \numcopies ->
 		stopUnless (inAnnex key) $
-			Command.Drop.startLocal afile ai numcopies key preverified
+			Command.Drop.startLocal afile ai si numcopies key preverified
 
 	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
-		Command.Drop.startRemote afile ai numcopies key r
+		Command.Drop.startRemote afile ai si numcopies key r
 
 	ai = mkActionItem (key, afile)
 

Annex/Import.hs

@@ -364,7 +364,8 @@ importKeys remote importtreeconfig importcontent importablecontents = do
 		[] -> do
 			job <- liftIO $ newEmptyTMVarIO
 			let ai = ActionItemOther (Just (fromRawFilePath (fromImportLocation loc)))
-			let importaction = starting ("import " ++ Remote.name remote) ai $ do
+			let si = SeekInput []
+			let importaction = starting ("import " ++ Remote.name remote) ai si $ do
 				when oldversion $
 					showNote "old version"
 				tryNonAsync (importordownload cidmap db i largematcher) >>= \case

Annex/Ssh.hs

@@ -34,6 +34,7 @@ import Annex.Path
 import Utility.Env
 import Utility.Hash
 import Types.CleanupActions
+import Annex.Concurrent.Utility
 import Types.Concurrency
 import Git.Env
 import Git.Ssh
@@ -107,7 +108,7 @@ sshCachingInfo (host, port) = go =<< sshCacheDir'
 	-- No connection caching with concurrency is not a good
 	-- combination, so warn the user.
 	go (Left whynocaching) = do
-		Annex.getState Annex.concurrency >>= \case
+		getConcurrency >>= \case
                 	NonConcurrent -> return ()
 			Concurrent {} -> warnnocaching whynocaching
 			ConcurrentPerCpu -> warnnocaching whynocaching
@@ -229,7 +230,7 @@ prepSocket socketfile sshhost sshparams = do
 	
 	let socketlock = socket2lock socketfile
 
-	Annex.getState Annex.concurrency >>= \case
+	getConcurrency >>= \case
 		NonConcurrent -> return ()
 		Concurrent {} -> makeconnection socketlock
 		ConcurrentPerCpu -> makeconnection socketlock

Annex/Transfer.hs

@@ -31,6 +31,7 @@ import Annex.LockPool
 import Types.Key
 import qualified Types.Remote as Remote
 import Types.Concurrency
+import Annex.Concurrent.Utility
 import Types.WorkerPool
 import Annex.WorkerPool
 import Backend (isCryptographicallySecure)
@@ -262,7 +263,7 @@ configuredRetry numretries _old new = do
  - increase total transfer speed.
  -}
 pickRemote :: Observable v => [Remote] -> (Remote -> Annex v) -> Annex v
-pickRemote l a = debugLocks $ go l =<< Annex.getState Annex.concurrency
+pickRemote l a = debugLocks $ go l =<< getConcurrency
   where
 	go [] _ = return observeFailure
 	go (r:[]) _ = a r

Assistant/Drop.hs

@@ -16,6 +16,7 @@ import Annex.Drop (handleDropsFrom, Reason)
 import Logs.Location
 import CmdLine.Action
 import Types.NumCopies
+import Types.Command
 
 {- Drop from local and/or remote when allowed by the preferred content and
  - numcopies settings. -}
@@ -23,4 +24,7 @@ handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> Assi
 handleDrops reason fromhere key f preverified = do
 	syncrs <- syncDataRemotes <$> getDaemonStatus
 	locs <- liftAnnex $ loggedLocations key
-	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f preverified callCommandAction
+	liftAnnex $ handleDropsFrom
+		locs syncrs reason fromhere key f
+		(SeekInput [])
+		preverified callCommandAction

Assistant/Threads/Committer.hs

@@ -24,6 +24,7 @@ import Utility.ThreadScheduler
 import qualified Utility.Lsof as Lsof
 import qualified Utility.DirWatcher as DirWatcher
 import Types.KeySource
+import Types.Command
 import Config
 import Annex.Content
 import Annex.Ingest
@@ -286,7 +287,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
 	  	ks = keySource ld
 		doadd = sanitycheck ks $ do
 			(mkey, _mcache) <- liftAnnex $ do
-				showStart "add" $ keyFilename ks
+				showStart "add" (keyFilename ks) (SeekInput [])
 				ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
 			maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey
 	add _ _ = return Nothing

Assistant/Threads/TransferScanner.hs

@@ -30,6 +30,7 @@ import Annex.WorkTree
 import Annex.Content
 import Annex.Wanted
 import CmdLine.Action
+import Types.Command
 
 import qualified Data.Set as S
 import Control.Concurrent
@@ -168,7 +169,7 @@ expensiveScan urlrenderer rs = batch <~> do
 
 		liftAnnex $ handleDropsFrom locs syncrs
 			"expensive scan found too many copies of object"
-			present key af [] callCommandAction
+			present key af (SeekInput []) [] callCommandAction
 		ts <- if present
 			then liftAnnex . filterM (wantSend True (Just key) af . Remote.uuid . fst)
 				=<< use syncDataRemotes (genTransfer Upload False)

CHANGELOG

@@ -1,5 +1,12 @@
 git-annex (8.20200909) UNRELEASED; urgency=medium
 
+  * --json output now includes a new field "input" which is the input
+    value (filename, url, etc) that caused a json object to be output.
+  * --batch combined with -J now runs batch requests concurrently for many
+    commands. Before, the combination was accepted, but did not enable
+    concurrency. Since the output of batch requests can be in any order,
+    --json with the new "input" field is recommended to be used,
+    to determine which batch request each response corresponds to.
   * aws-0.22 improved its support for setting etags, which improves
     support for versioned S3 buckets.
 

CmdLine/Action.hs

@@ -53,9 +53,11 @@ commandActions = mapM_ commandAction
  - This should only be run in the seek stage.
  -}
 commandAction :: CommandStart -> Annex ()
-commandAction start = Annex.getState Annex.concurrency >>= \case
+commandAction start = getConcurrency >>= \case
 	NonConcurrent -> runnonconcurrent
-	Concurrent _ -> runconcurrent
+	Concurrent n
+		| n > 1 -> runconcurrent
+		| otherwise -> runnonconcurrent
 	ConcurrentPerCpu -> runconcurrent
   where
 	runnonconcurrent = void $ includeCommandAction start
@@ -174,17 +176,11 @@ accountCommandAction startmsg cleanup = tryNonAsync cleanup >>= \case
  - stages, without catching errors and without incrementing error counter.
  - Useful if one command wants to run part of another command. -}
 callCommandAction :: CommandStart -> CommandCleanup
-callCommandAction = fromMaybe True <$$> callCommandAction' 
-
-{- Like callCommandAction, but returns Nothing when the command did not
- - perform any action. -}
-callCommandAction' :: CommandStart -> Annex (Maybe Bool)
-callCommandAction' start = 
-	start >>= \case
-		Nothing -> return Nothing
-		Just (startmsg, perform) -> do
-			showStartMessage startmsg
-			Just <$> performCommandAction' startmsg perform
+callCommandAction start = start >>= \case
+	Just (startmsg, perform) -> do
+		showStartMessage startmsg
+		performCommandAction' startmsg perform
+	Nothing -> return True
 
 performCommandAction' :: StartMessage -> CommandPerform -> CommandCleanup
 performCommandAction' startmsg perform = 
@@ -206,9 +202,9 @@ performCommandAction' startmsg perform =
  -}
 startConcurrency :: UsedStages -> Annex a -> Annex a
 startConcurrency usedstages a = do
-	fromcmdline <- Annex.getState Annex.concurrency
+	fromcmdline <- getConcurrency
 	fromgitcfg <- annexJobs <$> Annex.getGitConfig
-	let usegitcfg = setConcurrency fromgitcfg
+	let usegitcfg = setConcurrency (ConcurrencyGitConfig fromgitcfg)
 	case (fromcmdline, fromgitcfg) of
 		(NonConcurrent, NonConcurrent) -> a
 		(Concurrent n, _) ->
@@ -264,7 +260,7 @@ startConcurrency usedstages a = do
  - May be called repeatedly by the same thread without blocking. -}
 ensureOnlyActionOn :: Key -> Annex a -> Annex a
 ensureOnlyActionOn k a = debugLocks $
-	go =<< Annex.getState Annex.concurrency
+	go =<< getConcurrency
   where
 	go NonConcurrent = a
 	go (Concurrent _) = goconcurrent

CmdLine/Batch.hs

@@ -8,6 +8,7 @@
 module CmdLine.Batch where
 
 import Annex.Common
+import qualified Annex
 import Types.Command
 import CmdLine.Action
 import CmdLine.GitAnnex.Options
@@ -18,6 +19,8 @@ import Types.FileMatcher
 import Annex.BranchState
 import Annex.WorkTree
 import Annex.Content
+import Annex.Concurrent
+import Types.Concurrency
 
 data BatchMode = Batch BatchFormat | NoBatch
 
@@ -42,7 +45,9 @@ parseBatchOption = go
 -- In batch mode, one line at a time is read, parsed, and a reply output to
 -- stdout. In non batch mode, the command's parameters are parsed and
 -- a reply output for each.
-batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
+--
+-- Note that the actions are not run concurrently.
+batchable :: (opts -> SeekInput -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
 batchable handler parser paramdesc = batchseeker <$> batchparser
   where
 	batchparser = (,,)
@@ -51,12 +56,12 @@ batchable handler parser paramdesc = batchseeker <$> batchparser
 		<*> cmdParams paramdesc
 	
 	batchseeker (opts, NoBatch, params) =
-		mapM_ (go NoBatch opts) params
+		mapM_ (\p -> go NoBatch opts (SeekInput [p], p)) params
 	batchseeker (opts, batchmode@(Batch fmt), _) = 
 		batchInput fmt (pure . Right) (go batchmode opts)
 
-	go batchmode opts p =
-		unlessM (handler opts p) $
+	go batchmode opts (si, p) =
+		unlessM (handler opts si p) $
 			batchBadInput batchmode
 
 -- bad input is indicated by an empty line in batch mode. In non batch
@@ -72,17 +77,18 @@ batchBadInput (Batch _) = liftIO $ putStrLn ""
 -- be converted to relative. Normally, filename parameters are passed
 -- through git ls-files, which makes them relative, but batch mode does
 -- not use that, and absolute worktree files are likely to cause breakage.
-batchInput :: BatchFormat -> (String -> Annex (Either String a)) -> (a -> Annex ()) -> Annex ()
+batchInput :: BatchFormat -> (String -> Annex (Either String v)) -> ((SeekInput, v) -> Annex ()) -> Annex ()
 batchInput fmt parser a = go =<< batchLines fmt
   where
 	go [] = return ()
 	go (l:rest) = do
-		either parseerr a =<< parser l
+		either parseerr (\v -> a (SeekInput [l], v)) =<< parser l
 		go rest
 	parseerr s = giveup $ "Batch input parse failure: " ++ s
 
 batchLines :: BatchFormat -> Annex [String]
 batchLines fmt = do
+	checkBatchConcurrency
 	enableInteractiveBranchAccess
 	liftIO $ splitter <$> getContents
   where
@@ -90,45 +96,57 @@ batchLines fmt = do
 		BatchLine -> lines
 		BatchNull -> splitc '\0'
 
--- Runs a CommandStart in batch mode.
---
+-- When concurrency is enabled at the command line, it is used in batch
+-- mode. But, if it's only set in git config, don't use it, because the
+-- program using batch mode may not expect interleaved output.
+checkBatchConcurrency :: Annex ()
+checkBatchConcurrency = Annex.getState Annex.concurrency >>= \case
+	ConcurrencyCmdLine _ -> noop
+	ConcurrencyGitConfig _ -> 
+		setConcurrency (ConcurrencyGitConfig (Concurrent 1))
+
+batchCommandAction :: CommandStart -> Annex ()
+batchCommandAction = commandAction . batchCommandStart
+
 -- The batch mode user expects to read a line of output, and it's up to the
 -- CommandStart to generate that output as it succeeds or fails to do its
 -- job. However, if it stops without doing anything, it won't generate
--- any output, so in that case, batchBadInput is used to provide the caller
--- with an empty line.
-batchCommandAction :: CommandStart -> Annex ()
-batchCommandAction a = maybe (batchBadInput (Batch BatchLine)) (const noop)
-	=<< callCommandAction' a
+-- any output. This modifies it so in that case, an empty line is printed.
+batchCommandStart :: CommandStart -> CommandStart
+batchCommandStart a = a >>= \case
+	Just v -> return (Just v)
+	Nothing -> do
+		batchBadInput (Batch BatchLine)
+		return Nothing
 
 -- Reads lines of batch input and passes the filepaths to a CommandStart
 -- to handle them.
 --
--- Absolute filepaths are converted to relative.
+-- Absolute filepaths are converted to relative, because in non-batch
+-- mode, that is done when CmdLine.Seek uses git ls-files.
 --
--- File matching options are not checked.
-batchStart :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()
-batchStart fmt a = batchInput fmt (Right <$$> liftIO . relPathCwdToFile) $
-	batchCommandAction . a
-
--- Like batchStart, but checks the file matching options
--- and skips non-matching files.
-batchFilesMatching :: BatchFormat -> (RawFilePath -> CommandStart) -> Annex ()
+-- File matching options are checked, and non-matching files skipped.
+batchFilesMatching :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()
 batchFilesMatching fmt a = do
 	matcher <- getMatcher
-	batchStart fmt $ \f ->
+	go $ \si f ->
 		let f' = toRawFilePath f
 		in ifM (matcher $ MatchingFile $ FileInfo f' f')
-			( a f'
+			( a (si, f')
 			, return Nothing
 			)
+  where
+	go a' = batchInput fmt 
+		(Right <$$> liftIO . relPathCwdToFile)
+		(batchCommandAction . uncurry a')
 
 batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex ()
-batchAnnexedFilesMatching fmt seeker = batchFilesMatching fmt $
-	whenAnnexed $ \f k -> case checkContentPresent seeker of
-		Just v -> do
-			present <- inAnnex k
-			if present == v
-				then startAction seeker f k
-				else return Nothing
-		Nothing -> startAction seeker f k
+batchAnnexedFilesMatching fmt seeker = batchFilesMatching fmt $ \(si, bf) ->
+	flip whenAnnexed bf $ \f k -> 
+		case checkContentPresent seeker of
+			Just v -> do
+				present <- inAnnex k
+				if present == v
+					then startAction seeker si f k
+					else return Nothing
+			Nothing -> startAction seeker si f k

CmdLine/GitAnnex/Options.hs

@@ -392,7 +392,7 @@ jsonProgressOption =
 -- action in `allowConcurrentOutput`.
 jobsOption :: [GlobalOption]
 jobsOption = 
-	[ globalSetter setConcurrency $ 
+	[ globalSetter (setConcurrency . ConcurrencyCmdLine) $ 
 		option (maybeReader parseConcurrency)
 			( long "jobs" <> short 'J' 
 			<> metavar (paramNumber `paramOr` "cpus")

CmdLine/Seek.hs

@@ -50,7 +50,7 @@ import Control.Concurrent.Async
 import System.Posix.Types
 
 data AnnexedFileSeeker = AnnexedFileSeeker
-	{ startAction :: RawFilePath -> Key -> CommandStart
+	{ startAction :: SeekInput -> RawFilePath -> Key -> CommandStart
 	, checkContentPresent :: Maybe Bool
 	, usesLocationLog :: Bool
 	}
@@ -74,25 +74,18 @@ withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.ge
 		case fs of
 			[f] -> do
 				void $ liftIO $ cleanup
-				getfiles (f:c) ps
+				getfiles ((SeekInput [p], f):c) ps
 			[] -> do
 				void $ liftIO $ cleanup
 				getfiles c ps
 			_ -> giveup needforce
 withFilesInGitAnnexNonRecursive _ _ _ NoWorkTreeItems = noop
 
-withFilesNotInGit :: (RawFilePath -> CommandSeek) -> WorkTreeItems -> CommandSeek
-withFilesNotInGit a (WorkTreeItems l) = go =<< seek
-  where
-	seek = do
-		force <- Annex.getState Annex.force
-		g <- gitRepo
-		liftIO $ Git.Command.leaveZombie
-			<$> LsFiles.notInRepo [] force l' g
-	go fs = seekFiltered a $
-		return $ concat $ segmentPaths id l' fs
-	l' = map toRawFilePath l
-withFilesNotInGit _ NoWorkTreeItems = noop 
+withFilesNotInGit :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
+withFilesNotInGit ww a l = do
+	force <- Annex.getState Annex.force
+	seekFiltered a $
+		seekHelper id ww (const $ LsFiles.notInRepo [] force) l
 
 withPathContents :: ((FilePath, FilePath) -> CommandSeek) -> CmdParams -> CommandSeek
 withPathContents a params = do
@@ -119,23 +112,24 @@ withWords a params = a params
 withStrings :: (String -> CommandSeek) -> CmdParams -> CommandSeek
 withStrings a params = sequence_ $ map a params
 
-withPairs :: ((String, String) -> CommandSeek) -> CmdParams -> CommandSeek
-withPairs a params = sequence_ $ map a $ pairs [] params
+withPairs :: ((SeekInput, (String, String)) -> CommandSeek) -> CmdParams -> CommandSeek
+withPairs a params = sequence_ $ 
+	map (\p@(x,y) -> a (SeekInput [x,y], p)) (pairs [] params)
   where
 	pairs c [] = reverse c
 	pairs c (x:y:xs) = pairs ((x,y):c) xs
 	pairs _ _ = giveup "expected pairs"
 
-withFilesToBeCommitted :: (RawFilePath -> CommandSeek) -> WorkTreeItems -> CommandSeek
+withFilesToBeCommitted :: ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
 withFilesToBeCommitted a l = seekFiltered a $
 	seekHelper id WarnUnmatchWorkTreeItems (const LsFiles.stagedNotDeleted) l
 
 {- unlocked pointer files that are staged, and whose content has not been
  - modified-}
-withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> WorkTreeItems -> CommandSeek
+withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
 withUnmodifiedUnlockedPointers ww a l = seekFiltered a unlockedfiles
   where
-	unlockedfiles = filterM isUnmodifiedUnlocked 
+	unlockedfiles = filterM (isUnmodifiedUnlocked . snd)
 		=<< seekHelper id ww (const LsFiles.typeChangedStaged) l
 
 isUnmodifiedUnlocked :: RawFilePath -> Annex Bool
@@ -144,12 +138,12 @@ isUnmodifiedUnlocked f = catKeyFile f >>= \case
 	Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k
 
 {- Finds files that may be modified. -}
-withFilesMaybeModified :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> WorkTreeItems -> CommandSeek
+withFilesMaybeModified :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
 withFilesMaybeModified ww a params = seekFiltered a $
 	seekHelper id ww LsFiles.modified params
 
-withKeys :: (Key -> CommandSeek) -> CmdParams -> CommandSeek
-withKeys a l = sequence_ $ map (a . parse) l
+withKeys :: ((SeekInput, Key) -> CommandSeek) -> CmdParams -> CommandSeek
+withKeys a ls = sequence_ $ map (\l -> a (SeekInput [l], parse l)) ls
   where
 	parse p = fromMaybe (giveup "bad key") $ deserializeKey p
 
@@ -170,7 +164,7 @@ withKeyOptions
 	:: Maybe KeyOptions
 	-> Bool
 	-> AnnexedFileSeeker
-	-> ((Key, ActionItem) -> CommandSeek)
+	-> ((SeekInput, Key, ActionItem) -> CommandSeek)
 	-> (WorkTreeItems -> CommandSeek)
 	-> WorkTreeItems
 	-> CommandSeek
@@ -178,7 +172,7 @@ withKeyOptions ko auto seeker keyaction = withKeyOptions' ko auto mkkeyaction
   where
 	mkkeyaction = do
 		matcher <- Limit.getMatcher
-		return $ \v@(k, ai) -> checkseeker k $
+		return $ \v@(_si, k, ai) -> checkseeker k $
 			let i = case ai of
 				ActionItemBranchFilePath (BranchFilePath _ topf) _ ->
 					MatchingKey k (AssociatedFile $ Just $ getTopFilePath topf)
@@ -194,7 +188,7 @@ withKeyOptions ko auto seeker keyaction = withKeyOptions' ko auto mkkeyaction
 withKeyOptions' 
 	:: Maybe KeyOptions
 	-> Bool
-	-> Annex ((Key, ActionItem) -> Annex ())
+	-> Annex ((SeekInput, Key, ActionItem) -> Annex ())
 	-> (WorkTreeItems -> CommandSeek)
 	-> WorkTreeItems
 	-> CommandSeek
@@ -245,7 +239,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
 			Nothing -> return ()
 			Just ((k, f), content) -> do
 				maybe noop (Annex.BranchState.setCache f) content
-				keyaction (k, mkActionItem k)
+				keyaction (SeekInput [], k, mkActionItem k)
 				go reader
 		catObjectStreamLsTree l (getk . getTopFilePath . LsTree.file) g go
 		liftIO $ void cleanup
@@ -253,7 +247,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
 	runkeyaction getks = do
 		keyaction <- mkkeyaction
 		ks <- getks
-		forM_ ks $ \k -> keyaction (k, mkActionItem k)
+		forM_ ks $ \k -> keyaction (SeekInput [], k, mkActionItem k)
 	
 	runbranchkeys bs = do
 		keyaction <- mkkeyaction
@@ -263,7 +257,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
 				Nothing -> noop
 				Just k -> 
 					let bfp = mkActionItem (BranchFilePath b (LsTree.file i), k)
-					in keyaction (k, bfp)
+					in keyaction (SeekInput [], k, bfp)
 			unlessM (liftIO cleanup) $
 				error ("git ls-tree " ++ Git.fromRef b ++ " failed")
 	
@@ -272,21 +266,21 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
 		rs <- remoteList
 		ts <- concat <$> mapM (getFailedTransfers . Remote.uuid) rs
 		forM_ ts $ \(t, i) ->
-			keyaction (transferKey t, mkActionItem (t, i))
+			keyaction (SeekInput [], transferKey t, mkActionItem (t, i))
 
-seekFiltered :: (RawFilePath -> CommandSeek) -> Annex [RawFilePath] -> Annex ()
+seekFiltered :: ((SeekInput, RawFilePath) -> CommandSeek) -> Annex [(SeekInput, RawFilePath)] -> Annex ()
 seekFiltered a fs = do
 	matcher <- Limit.getMatcher
 	sequence_ =<< (map (process matcher) <$> fs)
   where
-	process matcher f =
-		whenM (matcher $ MatchingFile $ FileInfo f f) $ a f
+	process matcher v@(_si, f) =
+		whenM (matcher $ MatchingFile $ FileInfo f f) (a v)
 
 -- This is significantly faster than using lookupKey after seekFiltered,
 -- because of the way data is streamed through git cat-file.
 --
 -- It can also precache location logs using the same efficient streaming.
-seekFilteredKeys :: AnnexedFileSeeker -> Annex [(RawFilePath, Git.Sha, FileMode)] -> Annex ()
+seekFilteredKeys :: AnnexedFileSeeker -> Annex [(SeekInput, (RawFilePath, Git.Sha, FileMode))] -> Annex ()
 seekFilteredKeys seeker listfs = do
 	g <- Annex.gitRepo
 	matcher <- Limit.getMatcher
@@ -317,38 +311,38 @@ seekFilteredKeys seeker listfs = do
 		Nothing -> cont
 
 	finisher oreader = liftIO oreader >>= \case
-		Just (f, content) -> do
+		Just ((si, f), content) -> do
 			case parseLinkTargetOrPointerLazy =<< content of
 				Just k -> checkpresence k $
 					commandAction $
-						startAction seeker f k
+						startAction seeker si f k
 				Nothing -> noop
 			finisher oreader
 		Nothing -> return ()
 
 	precachefinisher lreader = liftIO lreader >>= \case
-		Just ((logf, f, k), logcontent) -> do
+		Just ((logf, (si, f), k), logcontent) -> do
 			maybe noop (Annex.BranchState.setCache logf) logcontent
-			commandAction $ startAction seeker f k
+			commandAction $ startAction seeker si f k
 			precachefinisher lreader
 		Nothing -> return ()
 	
 	precacher config oreader lfeeder lcloser = liftIO oreader >>= \case
-		Just (f, content) -> do
+		Just ((si, f), content) -> do
 			case parseLinkTargetOrPointerLazy =<< content of
 				Just k -> checkpresence k $
 					let logf = locationLogFile config k
 					    ref = Git.Ref.branchFileRef Annex.Branch.fullname logf
-					in liftIO $ lfeeder ((logf, f, k), ref)
+					in liftIO $ lfeeder ((logf, (si, f), k), ref)
 				Nothing -> noop
 			precacher config oreader lfeeder lcloser
 		Nothing -> liftIO $ void lcloser
 	
-	feedmatches matcher ofeeder f sha = 
+	feedmatches matcher ofeeder si f sha = 
 		whenM (matcher $ MatchingFile $ FileInfo f f) $
-			liftIO $ ofeeder (f, sha)
+			liftIO $ ofeeder ((si, f), sha)
 
-	process matcher ofeeder mdfeeder mdcloser seenpointer ((f, sha, mode):rest) =
+	process matcher ofeeder mdfeeder mdcloser seenpointer ((si, (f, sha, mode)):rest) =
 		case Git.toTreeItemType mode of
 			Just Git.TreeSymlink -> do
 				whenM (exists f) $
@@ -358,8 +352,8 @@ seekFilteredKeys seeker listfs = do
 					-- slower, but preserves the requested
 					-- file order.
 					if seenpointer
-						then liftIO $ mdfeeder (f, sha)
-						else feedmatches matcher ofeeder f sha
+						then liftIO $ mdfeeder ((si, f), sha)
+						else feedmatches matcher ofeeder si f sha
 				process matcher ofeeder mdfeeder mdcloser seenpointer rest
 			Just Git.TreeSubmodule ->
 				process matcher ofeeder mdfeeder mdcloser seenpointer rest
@@ -368,7 +362,7 @@ seekFilteredKeys seeker listfs = do
 			-- large files by first looking up the size.
 			Just _ -> do
 				whenM (exists f) $
-					liftIO $ mdfeeder (f, sha)
+					liftIO $ mdfeeder ((si, f), sha)
 				process matcher ofeeder mdfeeder mdcloser True rest
 			Nothing ->
 				process matcher ofeeder mdfeeder mdcloser seenpointer rest
@@ -379,19 +373,24 @@ seekFilteredKeys seeker listfs = do
 	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)
 
 	mdprocess matcher mdreader ofeeder ocloser = liftIO mdreader >>= \case
-		Just (f, Just (sha, size, _type))
+		Just ((si, f), Just (sha, size, _type))
 			| size < maxPointerSz -> do
-				feedmatches matcher ofeeder f sha
+				feedmatches matcher ofeeder si f sha
 				mdprocess matcher mdreader ofeeder ocloser
 		Just _ -> mdprocess matcher mdreader ofeeder ocloser
 		Nothing -> liftIO $ void ocloser
 
-seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex [a]
+seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex [(SeekInput, a)]
 seekHelper c ww a (WorkTreeItems l) = do
 	os <- seekOptions ww
 	inRepo $ \g ->
 		concat . concat <$> forM (segmentXargsOrdered l)
-			(runSegmentPaths c (\fs -> Git.Command.leaveZombie <$> a os fs g) . map toRawFilePath)
+			(runSegmentPaths' mk c (\fs -> Git.Command.leaveZombie <$> a os fs g) . map toRawFilePath)
+  where
+	mk (Just i) f = (SeekInput [fromRawFilePath i], f) 
+	-- This is not accurate, but it only happens when there are a
+	-- great many input WorkTreeItems.
+	mk Nothing f = (SeekInput [fromRawFilePath (c f)], f)
 seekHelper _ _ _ NoWorkTreeItems = return []
 
 data WarnUnmatchWhen = WarnUnmatchLsFiles | WarnUnmatchWorkTreeItems

Command.hs

@@ -74,13 +74,15 @@ withGlobalOptions :: [[GlobalOption]] -> Command -> Command
 withGlobalOptions os c = c { cmdglobaloptions = cmdglobaloptions c ++ concat os }
 
 {- For start stage to indicate what will be done. -}
-starting:: MkActionItem t => String -> t -> CommandPerform -> CommandStart
-starting msg t a = next (StartMessage msg (mkActionItem t), a)
+starting:: MkActionItem actionitem => String -> actionitem -> SeekInput -> CommandPerform -> CommandStart
+starting msg ai si a = next
+	(StartMessage msg (mkActionItem ai) si, a)
 
 {- Use when noMessages was used but the command is going to output
  - usual messages after all. -}
-startingUsualMessages :: MkActionItem t => String -> t -> CommandPerform -> CommandStart
-startingUsualMessages msg t a = next (StartUsualMessages msg (mkActionItem t), a)
+startingUsualMessages :: MkActionItem t => String -> t -> SeekInput -> CommandPerform -> CommandStart
+startingUsualMessages msg t si a = next 
+	(StartUsualMessages msg (mkActionItem t) si, a)
 
 {- When no message should be displayed at start/end, but messages can still 
  - be displayed when using eg includeCommandAction. -}

Command/Add.hs

@@ -64,18 +64,18 @@ seek o = startConcurrency commandStages $ do
 	largematcher <- largeFilesMatcher
 	addunlockedmatcher <- addUnlockedMatcher
 	annexdotfiles <- getGitConfigVal annexDotFiles 
-	let gofile file = case largeFilesOverride o of
+	let gofile (si, file) = case largeFilesOverride o of
 		Nothing -> 
 			let file' = fromRawFilePath file
 			in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force))
-				( start file addunlockedmatcher
+				( start si file addunlockedmatcher
 				, ifM (annexAddSmallFiles <$> Annex.getGitConfig)
-					( startSmall file
+					( startSmall si file
 					, stop
 					)
 				)
-		Just True -> start file addunlockedmatcher
-		Just False -> startSmallOverridden file
+		Just True -> start si file addunlockedmatcher
+		Just False -> startSmallOverridden si file
 	case batchOption o of
 		Batch fmt
 			| updateOnly o ->
@@ -90,13 +90,13 @@ seek o = startConcurrency commandStages $ do
 			l <- workTreeItems ww (addThese o)
 			let go a = a ww (commandAction . gofile) l
 			unless (updateOnly o) $
-				go (const withFilesNotInGit)
+				go withFilesNotInGit
 			go withFilesMaybeModified
 			go withUnmodifiedUnlockedPointers
 
 {- Pass file off to git-add. -}
-startSmall :: RawFilePath -> CommandStart
-startSmall file = starting "add" (ActionItemWorkTreeFile file) $
+startSmall :: SeekInput -> RawFilePath -> CommandStart
+startSmall si file = starting "add" (ActionItemWorkTreeFile file) si $
 	next $ addSmall file
 
 addSmall :: RawFilePath -> Annex Bool
@@ -104,8 +104,8 @@ addSmall file = do
 	showNote "non-large file; adding content to git repository"
 	addFile file
 
-startSmallOverridden :: RawFilePath -> CommandStart
-startSmallOverridden file = starting "add" (ActionItemWorkTreeFile file) $
+startSmallOverridden :: SeekInput -> RawFilePath -> CommandStart
+startSmallOverridden si file = starting "add" (ActionItemWorkTreeFile file) si $
 	next $ addSmallOverridden file
 
 addSmallOverridden :: RawFilePath -> Annex Bool
@@ -133,8 +133,8 @@ addFile file = do
 	Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file]
 	return True
 
-start :: RawFilePath -> AddUnlockedMatcher -> CommandStart
-start file addunlockedmatcher = do
+start :: SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart
+start si file addunlockedmatcher = do
 	mk <- liftIO $ isPointerFile file
 	maybe go fixuppointer mk
   where
@@ -144,7 +144,7 @@ start file addunlockedmatcher = do
 		Just s 
 			| not (isRegularFile s) && not (isSymbolicLink s) -> stop
 			| otherwise -> 
-				starting "add" (ActionItemWorkTreeFile file) $
+				starting "add" (ActionItemWorkTreeFile file) si $
 					if isSymbolicLink s
 						then next $ addFile file
 						else perform file addunlockedmatcher
@@ -152,13 +152,13 @@ start file addunlockedmatcher = do
 		liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case
 			Just s | isSymbolicLink s -> fixuplink key
 			_ -> add
-	fixuplink key = starting "add" (ActionItemWorkTreeFile file) $ do
+	fixuplink key = starting "add" (ActionItemWorkTreeFile file) si $ do
 		-- the annexed symlink is present but not yet added to git
 		liftIO $ removeFile (fromRawFilePath file)
 		addLink (fromRawFilePath file) key Nothing
 		next $
 			cleanup key =<< inAnnex key
-	fixuppointer key = starting "add" (ActionItemWorkTreeFile file) $ do
+	fixuppointer key = starting "add" (ActionItemWorkTreeFile file) si $ do
 		-- the pointer file is present, but not yet added to git
 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
 		next $ addFile file

Command/AddUrl.hs

@@ -104,12 +104,13 @@ parseDownloadOptions withfileoptions = DownloadOptions
 seek :: AddUrlOptions -> CommandSeek
 seek o = startConcurrency commandStages $ do
 	addunlockedmatcher <- addUnlockedMatcher
-	let go (o', u) = do
+	let go (si, (o', u)) = do
 		r <- Remote.claimingUrl u
 		if Remote.uuid r == webUUID || rawOption (downloadOptions o')
-			then void $ commandAction $ startWeb addunlockedmatcher o' u
-			else checkUrl addunlockedmatcher r o' u
-	forM_ (addUrls o) (\u -> go (o, u))
+			then void $ commandAction $
+				startWeb addunlockedmatcher o' si u
+			else checkUrl addunlockedmatcher r o' si u
+	forM_ (addUrls o) (\u -> go (SeekInput [u], (o, u)))
 	case batchOption o of
 		Batch fmt -> batchInput fmt (pure . parseBatchInput o) go
 		NoBatch -> noop
@@ -123,8 +124,8 @@ parseBatchInput o s
 			else Right (o { downloadOptions = (downloadOptions o) { fileOption = Just f } }, u)
 	| otherwise = Right (o, s)
 
-checkUrl :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> Annex ()
-checkUrl addunlockedmatcher r o u = do
+checkUrl :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> URLString -> Annex ()
+checkUrl addunlockedmatcher r o si u = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
 	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption (downloadOptions o))
 	go deffile =<< maybe
@@ -133,35 +134,35 @@ checkUrl addunlockedmatcher r o u = do
 		(Remote.checkUrl r)
   where
 
-	go _ (Left e) = void $ commandAction $ startingAddUrl u o $ do
+	go _ (Left e) = void $ commandAction $ startingAddUrl si u o $ do
 		warning (show e)
 		next $ return False
 	go deffile (Right (UrlContents sz mf)) = do
 		f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o) mf
 		let f' = adjustFile o (fromMaybe f (fileOption (downloadOptions o)))
-		void $ commandAction $ startRemote addunlockedmatcher r o f' u sz
+		void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz
 	go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of
 		Nothing ->
 			forM_ l $ \(u', sz, f) -> do
 				f' <- sanitizeOrPreserveFilePath o f
 				let f'' = adjustFile o (deffile </> f')
-				void $ commandAction $ startRemote addunlockedmatcher r o f'' u' sz
+				void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz
 		Just f -> case l of
 			[] -> noop
 			((u',sz,_):[]) -> do
 				let f' = adjustFile o f
-				void $ commandAction $ startRemote addunlockedmatcher r o f' u' sz
+				void $ commandAction $ startRemote addunlockedmatcher r o si f' u' sz
 			_ -> giveup $ unwords
 				[ "That url contains multiple files according to the"
 				, Remote.name r
 				, " remote; cannot add it to a single file."
 				]
 
-startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> FilePath -> URLString -> Maybe Integer -> CommandStart
-startRemote addunlockedmatcher r o file uri sz = do
+startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
+startRemote addunlockedmatcher r o si file uri sz = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
 	let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file
-	startingAddUrl uri o $ do
+	startingAddUrl si uri o $ do
 		showNote $ "from " ++ Remote.name r 
 		showDestinationFile file'
 		performRemote addunlockedmatcher r o uri file' sz
@@ -199,12 +200,12 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
 	loguri = setDownloader uri OtherDownloader
 	af = AssociatedFile (Just (toRawFilePath file))
 
-startWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> CommandStart
-startWeb addunlockedmatcher o urlstring = go $ fromMaybe bad $ parseURI urlstring
+startWeb :: AddUnlockedMatcher -> AddUrlOptions -> SeekInput -> URLString -> CommandStart
+startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURI urlstring
   where
 	bad = fromMaybe (giveup $ "bad url " ++ urlstring) $
 		Url.parseURIRelaxed $ urlstring
-	go url = startingAddUrl urlstring o $
+	go url = startingAddUrl si urlstring o $
 		if relaxedOption (downloadOptions o)
 			then go' url Url.assumeUrlExists
 			else Url.withUrlOptions (Url.getUrlInfo urlstring) >>= \case
@@ -353,8 +354,8 @@ downloadWeb addunlockedmatcher o url urlinfo file =
 {- The destination file is not known at start time unless the user provided
  - a filename. It's not displayed then for output consistency, 
  - but is added to the json when available. -}
-startingAddUrl :: URLString -> AddUrlOptions -> CommandPerform -> CommandStart
-startingAddUrl url o p = starting "addurl" (ActionItemOther (Just url)) $ do
+startingAddUrl :: SeekInput -> URLString -> AddUrlOptions -> CommandPerform -> CommandStart
+startingAddUrl si url o p = starting "addurl" (ActionItemOther (Just url)) si $ do
 	case fileOption (downloadOptions o) of
 		Nothing -> noop
 		Just file -> maybeShowJSON $ JSONChunk [("file", file)]

Command/Adjust.hs

@@ -51,5 +51,5 @@ seek = commandAction . start
 start :: Adjustment -> CommandStart
 start adj = do
 	checkVersionSupported
-	starting "adjust" (ActionItemOther Nothing) $
+	starting "adjust" (ActionItemOther Nothing) (SeekInput []) $
 		next $ enterAdjustedBranch adj

Command/CalcKey.hs

@@ -19,8 +19,8 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 		(paramRepeating paramFile)
 		(batchable run (pure ()))
 
-run :: () -> String -> Annex Bool
-run _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
+run :: () -> SeekInput -> String -> Annex Bool
+run _ _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
 	Right (k, _) -> do
 		liftIO $ putStrLn $ serializeKey k
 		return True

Command/CheckPresentKey.hs

@@ -39,7 +39,8 @@ seek o = case batchOption o of
 			(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
 			[] -> return (flip check Nothing)
 			_ -> wrongnumparams
-		batchInput fmt (pure . Right) $ checker >=> batchResult
+		batchInput fmt (pure . Right) $
+			checker . snd >=> batchResult
   where
 	wrongnumparams = giveup "Wrong number of parameters"
 					

Command/Commit.hs

@@ -10,6 +10,7 @@ module Command.Commit where
 import Command
 import qualified Annex.Branch
 import qualified Git
+import Git.Types
 
 cmd :: Command
 cmd = command "commit" SectionPlumbing 
@@ -20,10 +21,12 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing (commandAction start)
 
 start :: CommandStart
-start = starting "commit" (ActionItemOther (Just "git-annex")) $ do
-		Annex.Branch.commit =<< Annex.Branch.commitMessage
-		_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
-		next $ return True
+start = starting "commit" ai si $ do
+	Annex.Branch.commit =<< Annex.Branch.commitMessage
+	_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
+	next $ return True
   where
 	runhook (Just hook) = liftIO $ boolSystem hook []
 	runhook Nothing = return True
+	ai = ActionItemOther (Just (fromRef Annex.Branch.name))
+	si = SeekInput []

Command/Config.hs

@@ -55,24 +55,32 @@ optParser _ = setconfig <|> getconfig <|> unsetconfig
 
 seek :: Action -> CommandSeek
 seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandAction $
-	startingUsualMessages (decodeBS' name) (ActionItemOther (Just (fromConfigValue val))) $ do
+	startingUsualMessages (decodeBS' name) ai si $ do
 		setGlobalConfig ck val
 		when (needLocalUpdate ck) $
 			setConfig ck (fromConfigValue val)
 		next $ return True
+  where
+	ai = ActionItemOther (Just (fromConfigValue val))
+	si = SeekInput [decodeBS' name]
 seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
-	startingUsualMessages (decodeBS' name) (ActionItemOther (Just "unset")) $do
+	startingUsualMessages (decodeBS' name) ai si $ do
 		unsetGlobalConfig ck
 		when (needLocalUpdate ck) $
 			unsetConfig ck
 		next $ return True
+  where
+	ai = ActionItemOther (Just "unset")
+	si = SeekInput [decodeBS' name]
 seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $
-	startingCustomOutput (ActionItemOther Nothing) $ do
+	startingCustomOutput ai $ do
 		getGlobalConfig ck >>= \case
 			Just (ConfigValue v) -> liftIO $ S8.putStrLn v
 			Just NoConfigValue -> return ()
 			Nothing -> return ()
 		next $ return True
+  where
+	ai = ActionItemOther Nothing
 
 checkIsGlobalConfig :: ConfigKey -> Annex a -> Annex a
 checkIsGlobalConfig ck@(ConfigKey name) a

Command/ContentLocation.hs

@@ -20,8 +20,8 @@ cmd = noCommit $ noMessages $
 		(paramRepeating paramKey)
 		(batchable run (pure ()))
 
-run :: () -> String -> Annex Bool
-run _ p = do
+run :: () -> SeekInput -> String -> Annex Bool
+run _ _ p = do
 	let k = fromMaybe (giveup "bad key") $ deserializeKey p
 	maybe (return False) (\f -> liftIO (B8.putStrLn f) >> return True)
 		=<< inAnnex' (pure True) Nothing check k

Command/Copy.hs

@@ -67,9 +67,9 @@ seek o = startConcurrency commandStages $ do
 {- A copy is just a move that does not delete the source file.
  - However, auto mode avoids unnecessary copies, and avoids getting or
  - sending non-preferred content. -}
-start :: CopyOptions -> RawFilePath -> Key -> CommandStart
-start o file key = stopUnless shouldCopy $ 
-	Command.Move.start (fromToOptions o) Command.Move.RemoveNever file key
+start :: CopyOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o si file key = stopUnless shouldCopy $ 
+	Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
   where
 	shouldCopy
 		| autoMode o = want <||> numCopiesCheck (fromRawFilePath file) key (<)

Command/Dead.hs

@@ -32,11 +32,11 @@ seek (DeadRemotes rs) = trustCommand "dead" DeadTrusted rs
 seek (DeadKeys ks) = commandActions $ map startKey ks
 
 startKey :: Key -> CommandStart
-startKey key = starting "dead" (mkActionItem key) $
+startKey key = starting "dead" (mkActionItem key) (SeekInput []) $
 	keyLocations key >>= \case
 		[] -> performKey key
 		_ -> giveup "This key is still known to be present in some locations; not marking as dead."
-		
+
 performKey :: Key -> CommandPerform
 performKey key = do
 	setDead key

Command/Describe.hs

@@ -23,8 +23,11 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (name:description) | not (null description) = do
 	u <- Remote.nameToUUID name
-	starting "describe" (ActionItemOther (Just name)) $
+	starting "describe" ai si $
 		perform u $ unwords description
+  where
+	ai = ActionItemOther (Just name)
+	si = SeekInput [name]
 start _ = giveup "Specify a repository and a description."	
 
 perform :: UUID -> String -> CommandPerform

Command/Drop.hs

@@ -76,35 +76,35 @@ seek o = startConcurrency commandStages $ do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: DropOptions -> Maybe Remote -> RawFilePath -> Key -> CommandStart
-start o from file key = start' o from key afile ai
+start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o from si file key = start' o from key afile ai si
   where
 	afile = AssociatedFile (Just file)
 	ai = mkActionItem (key, afile)
 
-start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
-start' o from key afile ai = 
+start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
+start' o from key afile ai si = 
 	checkDropAuto (autoMode o) from afile key $ \numcopies ->
 		stopUnless want $
 			case from of
-				Nothing -> startLocal afile ai numcopies key []
-				Just remote -> startRemote afile ai numcopies key remote
+				Nothing -> startLocal afile ai si numcopies key []
+				Just remote -> startRemote afile ai si numcopies key remote
   where
 	want
 		| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
 		| otherwise = return True
 
-startKeys :: DropOptions -> Maybe Remote -> (Key, ActionItem) -> CommandStart
-startKeys o from (key, ai) = start' o from key (AssociatedFile Nothing) ai
+startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
+startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
 
-startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
-startLocal afile ai numcopies key preverified =
-	starting "drop" (OnlyActionOn key ai) $
+startLocal :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
+startLocal afile ai si numcopies key preverified =
+	starting "drop" (OnlyActionOn key ai) si $
 		performLocal key afile numcopies preverified
 
-startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
-startRemote afile ai numcopies key remote = 
-	starting ("drop " ++ Remote.name remote) (OnlyActionOn key ai) $
+startRemote :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> Key -> Remote -> CommandStart
+startRemote afile ai si numcopies key remote = 
+	starting ("drop " ++ Remote.name remote) (OnlyActionOn key ai) si $
 		performRemote key afile numcopies remote
 
 performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform

Command/DropKey.hs

@@ -41,8 +41,8 @@ seek o = do
   where
 	parsekey = maybe (Left "bad key") Right . deserializeKey
 
-start :: Key -> CommandStart
-start key = starting "dropkey" (mkActionItem key) $
+start :: (SeekInput, Key) -> CommandStart
+start (si, key) = starting "dropkey" (mkActionItem key) si $
 	perform key
 
 perform :: Key -> CommandPerform

Command/EnableRemote.hs

@@ -58,13 +58,16 @@ start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes
 -- the remote uuid.
 startNormalRemote :: Git.RemoteName -> [String] -> Git.Repo -> CommandStart
 startNormalRemote name restparams r
-	| null restparams = starting "enableremote" (ActionItemOther (Just name)) $ do
+	| null restparams = starting "enableremote" ai si $ do
 		setRemoteIgnore r False
 		r' <- Remote.Git.configRead False r
 		u <- getRepoUUID r'
 		next $ return $ u /= NoUUID
 	| otherwise = giveup $
 		"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams
+  where
+	ai = ActionItemOther (Just name)
+	si = SeekInput [name]
 
 startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart
 startSpecialRemote name config Nothing = do
@@ -76,13 +79,16 @@ startSpecialRemote name config Nothing = do
 				Just (u, fromMaybe M.empty (M.lookup u confm), Nothing)
 		_ -> unknownNameError "Unknown remote name."
 startSpecialRemote name config (Just (u, c, mcu)) =
-	starting "enableremote" (ActionItemOther (Just name)) $ do
+	starting "enableremote" ai si $ do
 		let fullconfig = config `M.union` c	
 		t <- either giveup return (SpecialRemote.findType fullconfig)
 		gc <- maybe (liftIO dummyRemoteGitConfig) 
 			(return . Remote.gitconfig)
 			=<< Remote.byUUID u
 		performSpecialRemote t u c fullconfig gc mcu
+  where
+	ai = ActionItemOther (Just name)
+	si = SeekInput [name]
 
 performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform
 performSpecialRemote t u oldc c gc mcu = do

Command/EnableTor.hs

@@ -47,12 +47,14 @@ start os = do
 start _os = do
 #endif
 #ifndef mingw32_HOST_OS
+	let ai = ActionItemOther Nothing
+	let si = SeekInput []
 	curruserid <- liftIO getEffectiveUserID
 	if curruserid == 0
 		then case readish =<< headMaybe os of
 			Nothing -> giveup "Need user-id parameter."
 			Just userid -> go userid
-		else starting "enable-tor" (ActionItemOther Nothing) $ do
+		else starting "enable-tor" ai si $ do
 			gitannex <- liftIO programPath
 			let ps = [Param (cmdname cmd), Param (show curruserid)]
 			sucommand <- liftIO $ mkSuCommand gitannex ps

Command/ExamineKey.hs

@@ -19,8 +19,8 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 			(paramRepeating paramKey)
 			(batchable run (optional parseFormatOption))
 
-run :: Maybe Utility.Format.Format -> String -> Annex Bool
-run format p = do
+run :: Maybe Utility.Format.Format -> SeekInput -> String -> Annex Bool
+run format _ p = do
 	let k = fromMaybe (giveup "bad key") $ deserializeKey p
 	showFormatted format (serializeKey' k) (keyVars k)
 	return True

Command/Expire.hs

@@ -60,13 +60,13 @@ start :: Expire -> Bool -> Log Activity -> UUIDDescMap -> UUID -> CommandStart
 start (Expire expire) noact actlog descs u =
 	case lastact of
 		Just ent | notexpired ent -> checktrust (== DeadTrusted) $
-			starting "unexpire" (ActionItemOther (Just desc)) $ do
+			starting "unexpire" ai si $ do
 				showNote =<< whenactive
 				unless noact $
 					trustSet u SemiTrusted
 				next $ return True
 		_ -> checktrust (/= DeadTrusted) $
-			starting "expire" (ActionItemOther (Just desc)) $ do
+			starting "expire" ai si $ do
 				showNote =<< whenactive
 				unless noact $
 					trustSet u DeadTrusted
@@ -79,6 +79,8 @@ start (Expire expire) noact actlog descs u =
 			return $ "last active: " ++ fromDuration d ++ " ago"
 		_  -> return "no activity"
 	desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
+	ai = ActionItemOther (Just desc)
+	si = SeekInput []
 	notexpired ent = case ent of
 		Unknown -> False
 		VectorClock c -> case lookupexpire of

Command/Export.hs

@@ -258,7 +258,7 @@ startExport :: Remote -> ExportHandle -> MVar FileUploaded -> MVar AllFilled ->
 startExport r db cvar allfilledvar ti = do
 	ek <- exportKey (Git.LsTree.sha ti)
 	stopUnless (notrecordedpresent ek) $
-		starting ("export " ++ name r) (ActionItemOther (Just (fromRawFilePath f))) $
+		starting ("export " ++ name r) ai si $
 			ifM (either (const False) id <$> tryNonAsync (checkPresentExport (exportActions r) (asKey ek) loc))
 				( next $ cleanupExport r db ek loc False
 				, do
@@ -269,6 +269,8 @@ startExport r db cvar allfilledvar ti = do
 	loc = mkExportLocation f
 	f = getTopFilePath (Git.LsTree.file ti)
 	af = AssociatedFile (Just f)
+	ai = ActionItemOther (Just (fromRawFilePath f))
+	si = SeekInput []
 	notrecordedpresent ek = (||)
 		<$> liftIO (notElem loc <$> getExportedLocation db (asKey ek))
 		-- If content was removed from the remote, the export db
@@ -321,18 +323,23 @@ startUnexport r db f shas = do
 	eks <- forM (filter (`notElem` nullShas) shas) exportKey
 	if null eks
 		then stop
-		else starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath f'))) $
+		else starting ("unexport " ++ name r) ai si $
 			performUnexport r db eks loc
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
+	ai = ActionItemOther (Just (fromRawFilePath f'))
+	si = SeekInput []
 
 startUnexport' :: Remote -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
-startUnexport' r db f ek = starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath f'))) $
-	performUnexport r db [ek] loc
+startUnexport' r db f ek =
+	starting ("unexport " ++ name r) ai si $
+		performUnexport r db [ek] loc
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
+	ai = ActionItemOther (Just (fromRawFilePath f'))
+	si = SeekInput []
 
 -- Unlike a usual drop from a repository, this does not check that
 -- numcopies is satisfied before removing the content. Typically an export
@@ -373,30 +380,36 @@ startRecoverIncomplete r db sha oldf
 	| otherwise = do
 		ek <- exportKey sha
 		let loc = exportTempName ek
-		starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath (fromExportLocation loc)))) $ do
+		let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation loc)))
+		let si = SeekInput []
+		starting ("unexport " ++ name r) ai si $ do
 			liftIO $ removeExportedLocation db (asKey ek) oldloc
 			performUnexport r db [ek] loc
   where
 	oldloc = mkExportLocation $ getTopFilePath oldf
 
 startMoveToTempName :: Remote -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
-startMoveToTempName r db f ek = starting ("rename " ++ name r) 
-	(ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc))
-	(performRename r db ek loc tmploc)
+startMoveToTempName r db f ek = 
+	starting ("rename " ++ name r) ai si $
+		performRename r db ek loc tmploc
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
 	tmploc = exportTempName ek
+	ai = ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc)
+	si = SeekInput []
 
 startMoveFromTempName :: Remote -> ExportHandle -> ExportKey -> TopFilePath -> CommandStart
 startMoveFromTempName r db ek f = do
 	let tmploc = exportTempName ek
+	let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ fromRawFilePath f'))
 	stopUnless (liftIO $ elem tmploc <$> getExportedLocation db (asKey ek)) $
-		starting ("rename " ++ name r) (ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ fromRawFilePath f'))) $
+		starting ("rename " ++ name r) ai si $
 			performRename r db ek tmploc loc
   where
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
+	si = SeekInput []
 
 performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
 performRename r db ek src dest =

Command/Find.hs

@@ -73,14 +73,14 @@ seek o = do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: FindOptions -> RawFilePath -> Key -> CommandStart
-start o file key = startingCustomOutput key $ do
+start :: FindOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o _ file key = startingCustomOutput key $ do
 	showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key
 	next $ return True
 
-startKeys :: FindOptions -> (Key, ActionItem) -> CommandStart
-startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = 
-	start o (getTopFilePath topf) key
+startKeys :: FindOptions -> (SeekInput, Key, ActionItem) -> CommandStart
+startKeys o (si, key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = 
+	start o si (getTopFilePath topf) key
 startKeys _ _ = stop
 
 showFormatted :: Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex ()

Command/Fix.hs

@@ -43,8 +43,8 @@ seek ps = unlessM crippledFileSystem $
 
 data FixWhat = FixSymlinks | FixAll
 
-start :: FixWhat -> RawFilePath -> Key -> CommandStart
-start fixwhat file key = do
+start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart
+start fixwhat si file key = do
 	currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file
 	wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
 	case currlink of
@@ -56,7 +56,7 @@ start fixwhat file key = do
 			FixAll -> fixthin
 			FixSymlinks -> stop
   where
-	fixby = starting "fix" (mkActionItem (key, file))
+	fixby = starting "fix" (mkActionItem (key, file)) si
 	fixthin = do
 		obj <- calcRepo (gitAnnexLocation key)
 		stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do

Command/Forget.hs

@@ -12,6 +12,7 @@ import qualified Annex.Branch as Branch
 import Logs.Transitions
 import qualified Annex
 import Annex.VectorClock
+import Git.Types
 
 cmd :: Command
 cmd = command "forget" SectionMaintenance 
@@ -33,13 +34,16 @@ seek :: ForgetOptions -> CommandSeek
 seek = commandAction . start
 
 start :: ForgetOptions -> CommandStart
-start o = starting "forget" (ActionItemOther (Just "git-annex")) $ do
+start o = starting "forget" ai si $ do
 	c <- liftIO currentVectorClock
 	let basets = addTransition c ForgetGitHistory noTransitions
 	let ts = if dropDead o
 		then addTransition c ForgetDeadRemotes basets
 		else basets
 	perform ts =<< Annex.getState Annex.force
+  where
+	ai = ActionItemOther (Just (fromRef Branch.name))
+	si = SeekInput []
 
 perform :: Transitions -> Bool -> CommandPerform
 perform ts True = do

Command/FromKey.hs

@@ -45,27 +45,30 @@ seek o = case (batchOption o, keyFilePairs o) of
 		withPairs (commandAction . start force) ps
 
 seekBatch :: BatchFormat -> CommandSeek
-seekBatch fmt = batchInput fmt parse commandAction
+seekBatch fmt = batchInput fmt parse (commandAction . go)
   where
 	parse s = do
 		let (keyname, file) = separate (== ' ') s
 		if not (null keyname) && not (null file)
 			then do
 				file' <- liftIO $ relPathCwdToFile file
-				return $ Right $ go file' (keyOpt keyname)
+				return $ Right (file', keyOpt keyname)
 			else return $
 				Left "Expected pairs of key and filename"
-	go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
-		perform key file
+	go (si, (file, key)) = 
+		let ai = mkActionItem (key, toRawFilePath file)
+		in starting "fromkey" ai si $
+			perform key file
 
-start :: Bool -> (String, FilePath) -> CommandStart
-start force (keyname, file) = do
+start :: Bool -> (SeekInput, (String, FilePath)) -> CommandStart
+start force (si, (keyname, file)) = do
 	let key = keyOpt keyname
 	unless force $ do
 		inbackend <- inAnnex key
 		unless inbackend $ giveup $
 			"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
-	starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
+	let ai = mkActionItem (key, toRawFilePath file)
+	starting "fromkey" ai si $
 		perform key file
 
 -- From user input to a Key.

Command/Fsck.hs

@@ -111,8 +111,8 @@ checkDeadRepo u =
 	whenM ((==) DeadTrusted <$> lookupTrust u) $
 		earlyWarning "Warning: Fscking a repository that is currently marked as dead."
 
-start :: Maybe Remote -> Incremental -> RawFilePath -> Key -> CommandStart
-start from inc file key = Backend.getBackend (fromRawFilePath file) key >>= \case
+start :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> CommandStart
+start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case
 	Nothing -> stop
 	Just backend -> do
 		numcopies <- getFileNumCopies (fromRawFilePath file)
@@ -120,7 +120,7 @@ start from inc file key = Backend.getBackend (fromRawFilePath file) key >>= \cas
 			Nothing -> go $ perform key file backend numcopies
 			Just r -> go $ performRemote key afile backend numcopies r
   where
-	go = runFsck inc (mkActionItem (key, afile)) key
+	go = runFsck inc si (mkActionItem (key, afile)) key
 	afile = AssociatedFile (Just file)
 
 perform :: Key -> RawFilePath -> Backend -> NumCopies -> Annex Bool
@@ -197,11 +197,11 @@ performRemote key afile backend numcopies remote =
 		Just a -> isRight <$> tryNonAsync (a key afile tmp)
 		Nothing -> return False
 
-startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart
-startKey from inc (key, ai) numcopies =
+startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart
+startKey from inc (si, key, ai) numcopies =
 	Backend.maybeLookupBackendVariety (fromKey keyVariety key) >>= \case
 		Nothing -> stop
-		Just backend -> runFsck inc ai key $
+		Just backend -> runFsck inc si ai key $
 			case from of
 				Nothing -> performKey key backend numcopies
 				Just r -> performRemote key (AssociatedFile Nothing) backend numcopies r
@@ -555,9 +555,9 @@ badContentRemote remote localcopy key = do
 		(False, Right ()) -> "dropped from " ++ Remote.name remote
 		(_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e
 
-runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
-runFsck inc ai key a = stopUnless (needFsck inc key) $
-	starting "fsck" (OnlyActionOn key ai) $ do
+runFsck :: Incremental -> SeekInput -> ActionItem -> Key -> Annex Bool -> CommandStart
+runFsck inc si ai key a = stopUnless (needFsck inc key) $
+	starting "fsck" (OnlyActionOn key ai) si $ do
 		ok <- a
 		when ok $
 			recordFsckTime inc key

Command/FuzzTest.hs

@@ -36,7 +36,7 @@ start :: CommandStart
 start = do
 	guardTest
 	logf <- fromRepo gitAnnexFuzzTestLogFile
-	showStart "fuzztest" (toRawFilePath logf)
+	showStart "fuzztest" (toRawFilePath logf) (SeekInput [])
 	logh <- liftIO $ openFile logf WriteMode
 	void $ forever $ fuzz logh
 	stop

Command/GCryptSetup.hs

@@ -22,7 +22,7 @@ seek :: CmdParams -> CommandSeek
 seek = withStrings (commandAction . start)
 
 start :: String -> CommandStart
-start gcryptid = starting "gcryptsetup" (ActionItemOther Nothing) $ do
+start gcryptid = starting "gcryptsetup" (ActionItemOther Nothing) (SeekInput [gcryptid]) $ do
 	u <- getUUID
 	when (u /= NoUUID) $
 		giveup "gcryptsetup refusing to run; this repository already has a git-annex uuid!"

Command/Get.hs

@@ -54,8 +54,8 @@ seek o = startConcurrency downloadStages $ do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: GetOptions -> Maybe Remote -> RawFilePath -> Key -> CommandStart
-start o from file key = start' expensivecheck from key afile ai
+start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o from si file key = start' expensivecheck from key afile ai si
   where
 	afile = AssociatedFile (Just file)
 	ai = mkActionItem (key, afile)
@@ -64,12 +64,12 @@ start o from file key = start' expensivecheck from key afile ai
 			<||> wantGet False (Just key) afile
 		| otherwise = return True
 
-startKeys :: Maybe Remote -> (Key, ActionItem) -> CommandStart
-startKeys from (key, ai) = checkFailedTransferDirection ai Download $
-	start' (return True) from key (AssociatedFile Nothing) ai
+startKeys :: Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
+startKeys from (si, key, ai) = checkFailedTransferDirection ai Download $
+	start' (return True) from key (AssociatedFile Nothing) ai si
 
-start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
-start' expensivecheck from key afile ai =
+start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
+start' expensivecheck from key afile ai si =
 	stopUnless expensivecheck $
 		case from of
 			Nothing -> go $ perform key afile
@@ -77,7 +77,7 @@ start' expensivecheck from key afile ai =
 				stopUnless (Command.Move.fromOk src key) $
 					go $ Command.Move.fromPerform src Command.Move.RemoveNever key afile
   where
-	go = starting "get" (OnlyActionOn key ai)
+	go = starting "get" (OnlyActionOn key ai) si
 
 perform :: Key -> AssociatedFile -> CommandPerform
 perform key afile = stopUnless (getKey key afile) $

Command/Group.hs

@@ -22,10 +22,13 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start (name:g:[]) = do
+start ps@(name:g:[]) = do
 	u <- Remote.nameToUUID name
-	startingUsualMessages "group" (ActionItemOther (Just name)) $
+	startingUsualMessages "group" ai si $
 		setGroup u (toGroup g)
+  where
+	ai = ActionItemOther (Just name)
+	si = SeekInput ps
 start (name:[]) = do
 	u <- Remote.nameToUUID name
 	startingCustomOutput (ActionItemOther Nothing) $ do

Command/GroupWanted.hs

@@ -24,6 +24,9 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (g:[]) = startingCustomOutput (ActionItemOther Nothing) $
 	performGet groupPreferredContentMapRaw (toGroup g)
-start (g:expr:[]) = startingUsualMessages "groupwanted" (ActionItemOther (Just g)) $
+start ps@(g:expr:[]) = startingUsualMessages "groupwanted" ai si $
 	performSet groupPreferredContentSet expr (toGroup g)
+  where
+	ai = ActionItemOther (Just g)
+	si = SeekInput ps
 start _ = giveup "Specify a group."

Command/Import.hs

@@ -125,11 +125,13 @@ seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do
 startLocal :: AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart
 startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
 	ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
-		( starting "import" (ActionItemWorkTreeFile destfile')
-			pickaction
+		( starting "import" ai si pickaction
 		, stop
 		)
   where
+ 	ai = ActionItemWorkTreeFile destfile'
+	si = SeekInput []
+
 	destfile' = toRawFilePath destfile
 
 	deletedup k = do
@@ -302,7 +304,7 @@ seekRemote remote branch msubdir importcontent = do
 	fromtrackingbranch a = inRepo $ a (fromRemoteTrackingBranch tb)
 
 listContents :: Remote -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart
-listContents remote tvar = starting "list" (ActionItemOther (Just (Remote.name remote))) $
+listContents remote tvar = starting "list" ai si $
 	listImportableContents remote >>= \case
 		Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
 		Just importable -> do
@@ -312,14 +314,18 @@ listContents remote tvar = starting "list" (ActionItemOther (Just (Remote.name r
 			next $ do
 				liftIO $ atomically $ writeTVar tvar (Just importable')
 				return True
+  where
+	ai = ActionItemOther (Just (Remote.name remote))
+	si = SeekInput []
 
 commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents (Either Sha Key) -> CommandStart
 commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig importable =
-	starting "update" (ActionItemOther (Just $ fromRef $ fromRemoteTrackingBranch tb)) $ do
+	starting "update" ai si $ do
 		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
 		next $ updateremotetrackingbranch importcommit
-		
   where
+	ai = ActionItemOther (Just $ fromRef $ fromRemoteTrackingBranch tb)
+	si = SeekInput []
 	-- Update the tracking branch. Done even when there
 	-- is nothing new to import, to make sure it exists.
 	updateremotetrackingbranch importcommit =

Command/ImportFeed.hs

@@ -78,7 +78,7 @@ seek o = do
 
 getFeed :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> URLString -> CommandSeek
 getFeed addunlockedmatcher opts cache url = do
-	showStart' "importfeed" (Just url)
+	showStartOther "importfeed" (Just url) (SeekInput [])
 	downloadFeed url >>= \case
 		Nothing -> showEndResult =<< feedProblem url
 			"downloading the feed failed"
@@ -124,7 +124,7 @@ getCache :: Maybe String -> Annex Cache
 getCache opttemplate = ifM (Annex.getState Annex.force)
 	( ret S.empty S.empty
 	, do
-		showStart "importfeed" "checking known urls"
+		showStart "importfeed" "checking known urls" (SeekInput [])
 		(is, us) <- unzip <$> knownItems
 		showEndOk
 		ret (S.fromList us) (S.fromList (concat is))
@@ -256,7 +256,7 @@ performDownload addunlockedmatcher opts cache todownload = case location todownl
 		case dest of
 			Nothing -> return True
 			Just f -> do
-				showStart' "addurl" (Just url)
+				showStartOther "addurl" (Just url) (SeekInput [])
 				ks <- getter f
 				if null ks
 					then do

Command/InAnnex.hs

@@ -20,8 +20,8 @@ cmd = noCommit $
 seek :: CmdParams -> CommandSeek
 seek = withKeys (commandAction . start)
 
-start :: Key -> CommandStart
-start key = inAnnexSafe key >>= dispatch
+start :: (SeekInput, Key) -> CommandStart
+start (_, key) = inAnnexSafe key >>= dispatch
   where
 	dispatch (Just True) = stop
 	dispatch (Just False) = exit 1

Command/Info.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -125,7 +125,7 @@ start o [] = do
 	globalInfo o
 	stop
 start o ps = do
-	mapM_ (itemInfo o) ps
+	mapM_ (\p -> itemInfo o (SeekInput [p], p)) ps
 	stop
 
 globalInfo :: InfoOptions -> Annex ()
@@ -135,34 +135,34 @@ globalInfo o = do
 	whenM ((==) DeadTrusted <$> lookupTrust u) $
 		earlyWarning "Warning: This repository is currently marked as dead."
 	stats <- selStats global_fast_stats global_slow_stats
-	showCustom "info" $ do
+	showCustom "info" (SeekInput []) $ do
 		evalStateT (mapM_ showStat stats) (emptyStatInfo o)
 		return True
 
-itemInfo :: InfoOptions -> String -> Annex ()
-itemInfo o p = ifM (isdir p)
-	( dirInfo o p
+itemInfo :: InfoOptions -> (SeekInput, String) -> Annex ()
+itemInfo o (si, p) = ifM (isdir p)
+	( dirInfo o p si
 	, do
 		disallowMatchingOptions
 		v <- Remote.byName' p
 		case v of
-			Right r -> remoteInfo o r
+			Right r -> remoteInfo o r si
 			Left _ -> do
 				v' <- Remote.nameToUUID' p
 				case v' of
-					Right u -> uuidInfo o u
+					Right u -> uuidInfo o u si
 					Left _ -> do
 						relp <- liftIO $ relPathCwdToFile p
 						ifAnnexed (toRawFilePath relp)
-							(fileInfo o relp)
-							(treeishInfo o p)
+							(fileInfo o relp si)
+							(treeishInfo o p si)
 	)
   where
 	isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
 
-noInfo :: String -> Annex ()
-noInfo s = do
-	showStart "info" (encodeBS' s)
+noInfo :: String -> SeekInput -> Annex ()
+noInfo s si = do
+	showStart "info" (encodeBS' s) si
 	showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid"
 	showEndFail
 
@@ -170,8 +170,8 @@ disallowMatchingOptions :: Annex ()
 disallowMatchingOptions = whenM Limit.limited $
 	giveup "File matching options can only be used when getting info on a directory."
 
-dirInfo :: InfoOptions -> FilePath -> Annex ()
-dirInfo o dir = showCustom (unwords ["info", dir]) $ do
+dirInfo :: InfoOptions -> FilePath -> SeekInput -> Annex ()
+dirInfo o dir si = showCustom (unwords ["info", dir]) si $ do
 	stats <- selStats
 		(tostats (dir_name:tree_fast_stats True))
 		(tostats tree_slow_stats)
@@ -180,12 +180,12 @@ dirInfo o dir = showCustom (unwords ["info", dir]) $ do
   where
 	tostats = map (\s -> s dir)
 
-treeishInfo :: InfoOptions -> String -> Annex ()
-treeishInfo o t = do
+treeishInfo :: InfoOptions -> String -> SeekInput -> Annex ()
+treeishInfo o t si = do
 	mi <- getTreeStatInfo o (Git.Ref (encodeBS' t))
 	case mi of
-		Nothing -> noInfo t
-		Just i -> showCustom (unwords ["info", t]) $ do
+		Nothing -> noInfo t si
+		Just i -> showCustom (unwords ["info", t]) si $ do
 			stats <- selStats 
 				(tostats (tree_name:tree_fast_stats False)) 
 				(tostats tree_slow_stats)
@@ -194,13 +194,13 @@ treeishInfo o t = do
   where
 	tostats = map (\s -> s t)
 
-fileInfo :: InfoOptions -> FilePath -> Key -> Annex ()
-fileInfo o file k = showCustom (unwords ["info", file]) $ do
+fileInfo :: InfoOptions -> FilePath -> SeekInput -> Key -> Annex ()
+fileInfo o file si k = showCustom (unwords ["info", file]) si $ do
 	evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)
 	return True
 
-remoteInfo :: InfoOptions -> Remote -> Annex ()
-remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do
+remoteInfo :: InfoOptions -> Remote -> SeekInput -> Annex ()
+remoteInfo o r si = showCustom (unwords ["info", Remote.name r]) si $ do
 	i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
 	let u = Remote.uuid r
 	l <- selStats 
@@ -209,8 +209,8 @@ remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do
 	evalStateT (mapM_ showStat l) (emptyStatInfo o)
 	return True
 
-uuidInfo :: InfoOptions -> UUID -> Annex ()
-uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do
+uuidInfo :: InfoOptions -> UUID -> SeekInput -> Annex ()
+uuidInfo o u si = showCustom (unwords ["info", fromUUID u]) si $ do
 	l <- selStats (uuid_fast_stats u) (uuid_slow_stats u)
 	evalStateT (mapM_ showStat l) (emptyStatInfo o)
 	return True

Command/Init.hs

@@ -53,10 +53,14 @@ seek = commandAction . start
 
 start :: InitOptions -> CommandStart
 start os
-	| autoEnableOnly os = starting "init" (ActionItemOther (Just "autoenable")) $
-		performAutoEnableOnly
-	| otherwise = starting "init" (ActionItemOther (Just $ initDesc os)) $
-		perform os
+	| autoEnableOnly os = 
+		starting "init" (ActionItemOther (Just "autoenable")) si $
+			performAutoEnableOnly
+	| otherwise = 
+		starting "init" (ActionItemOther (Just $ initDesc os)) si $
+			perform os
+  where
+	si = SeekInput []
 
 perform :: InitOptions -> CommandPerform
 perform os = do

Command/InitRemote.hs

@@ -62,25 +62,26 @@ start _ [] = giveup "Specify a name for the remote."
 start o (name:ws) = ifM (isJust <$> findExisting name)
 	( giveup $ "There is already a special remote named \"" ++ name ++
 		"\". (Use enableremote to enable an existing special remote.)"
-	, do
-		ifM (isJust <$> Remote.byNameOnly name)
-			( giveup $ "There is already a remote named \"" ++ name ++ "\""
-			, do
-				sameasuuid <- maybe
-					(pure Nothing)
-					(Just . Sameas <$$> getParsed)
-					(sameas o) 
-				c <- newConfig name sameasuuid
-					(Logs.Remote.keyValToConfig Proposed ws)
-					<$> readRemoteLog
-				t <- either giveup return (findType c)
-				if whatElse o
-					then startingCustomOutput (ActionItemOther Nothing) $
-						describeOtherParamsFor c t
-					else starting "initremote" (ActionItemOther (Just name)) $
-						perform t name c o
-			)
+	, ifM (isJust <$> Remote.byNameOnly name)
+		( giveup $ "There is already a remote named \"" ++ name ++ "\""
+		, do
+			sameasuuid <- maybe
+				(pure Nothing)
+				(Just . Sameas <$$> getParsed)
+				(sameas o) 
+			c <- newConfig name sameasuuid
+				(Logs.Remote.keyValToConfig Proposed ws)
+				<$> readRemoteLog
+			t <- either giveup return (findType c)
+			if whatElse o
+				then startingCustomOutput (ActionItemOther Nothing) $
+					describeOtherParamsFor c t
+				else starting "initremote" (ActionItemOther (Just name)) si $
+					perform t name c o
+		)
 	)
+  where
+	si = SeekInput [name]
 
 perform :: RemoteType -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandPerform
 perform t name c o = do

Command/Inprogress.hs

@@ -48,8 +48,8 @@ seek o = do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: S.Set Key -> RawFilePath -> Key -> CommandStart
-start s _file k
+start :: S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
+start s _si _file k
 	| S.member k s = start' k
 	| otherwise = stop
 

Command/List.hs

@@ -77,8 +77,8 @@ getList o
 printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
 printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
 
-start :: [(UUID, RemoteName, TrustLevel)] -> RawFilePath -> Key -> CommandStart
-start l file key = do
+start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart
+start l _si file key = do
 	ls <- S.fromList <$> keyLocations key
 	liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
 	stop

Command/Lock.hs

@@ -37,10 +37,10 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
 		, usesLocationLog = False
 		}
 
-start :: RawFilePath -> Key -> CommandStart
-start file key = ifM (isJust <$> isAnnexLink file)
+start :: SeekInput -> RawFilePath -> Key -> CommandStart
+start si file key = ifM (isJust <$> isAnnexLink file)
 	( stop
-	, starting "lock" (mkActionItem (key, file)) $
+	, starting "lock" (mkActionItem (key, file)) si $
 		go =<< liftIO (isPointerFile file)
 	)
   where

Command/Log.hs

@@ -100,8 +100,8 @@ seek o = do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: LogOptions -> (FilePath -> Outputter) -> RawFilePath -> Key -> CommandStart
-start o outputter file key = do
+start :: LogOptions -> (FilePath -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o outputter _ file key = do
 	(changes, cleanup) <- getKeyLog key (passthruOptions o)
 	showLogIncremental (outputter (fromRawFilePath file)) changes
 	void $ liftIO cleanup

Command/LookupKey.hs

@@ -18,8 +18,8 @@ cmd = notBareRepo $ noCommit $ noMessages $
 		(paramRepeating paramFile)
 		(batchable run (pure ()))
 
-run :: () -> String -> Annex Bool
-run _ file = seekSingleGitFile file >>= \case
+run :: () -> SeekInput -> String -> Annex Bool
+run _ _ file = seekSingleGitFile file >>= \case
 	Nothing -> return False
 	Just file' -> catKeyFile file' >>= \case
 		Just k  -> do

Command/Map.hs

@@ -197,7 +197,7 @@ same a b
 {- reads the config of a remote, with progress display -}
 scan :: Git.Repo -> Annex Git.Repo
 scan r = do
-	showStart' "map" (Just $ Git.repoDescribe r)
+	showStartOther "map" (Just $ Git.repoDescribe r) (SeekInput [])
 	v <- tryScan r
 	case v of
 		Just r' -> do

Command/Merge.hs

@@ -13,6 +13,7 @@ import qualified Git
 import qualified Git.Branch
 import Annex.CurrentBranch
 import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge, SyncOptions(..))
+import Git.Types
 
 cmd :: Command
 cmd = command "merge" SectionMaintenance
@@ -29,17 +30,23 @@ seek bs = do
 	forM_ bs (commandAction . mergeBranch . Git.Ref . encodeBS')
 
 mergeAnnexBranch :: CommandStart
-mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do
+mergeAnnexBranch = starting "merge" ai si $ do
 	_ <- Annex.Branch.update
 	-- commit explicitly, in case no remote branches were merged
 	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	next $ return True
+  where
+	ai = ActionItemOther (Just (fromRef Annex.Branch.name))
+	si = SeekInput []
 
 mergeSyncedBranch :: CommandStart
 mergeSyncedBranch = mergeLocal mergeConfig def =<< getCurrentBranch
 
 mergeBranch :: Git.Ref -> CommandStart
-mergeBranch r = starting "merge" (ActionItemOther (Just (Git.fromRef r))) $ do
+mergeBranch r = starting "merge" ai si $ do
 	currbranch <- getCurrentBranch
 	let o = def { notOnlyAnnexOption = True }
 	next $ merge currbranch mergeConfig o Git.Branch.ManualCommit r
+  where
+	ai = ActionItemOther (Just (Git.fromRef r))
+	si = SeekInput []

Command/MetaData.hs

@@ -93,24 +93,24 @@ seek o = case batchOption o of
 	Batch fmt -> withMessageState $ \s -> case outputType s of
 		JSONOutput _ -> ifM limited
 			( giveup "combining --batch with file matching options is not currently supported"
-			, batchInput fmt parseJSONInput $
-				commandAction . startBatch
+			, batchInput fmt parseJSONInput 
+				(commandAction . startBatch)
 			)
 		_ -> giveup "--batch is currently only supported in --json mode"
 
-start :: VectorClock -> MetaDataOptions -> RawFilePath -> Key -> CommandStart
-start c o file k = startKeys c o (k, mkActionItem (k, afile))
+start :: VectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
+start c o si file k = startKeys c o (si, k, mkActionItem (k, afile))
   where
 	afile = AssociatedFile (Just file)
 
-startKeys :: VectorClock -> MetaDataOptions -> (Key, ActionItem) -> CommandStart
-startKeys c o (k, ai) = case getSet o of
+startKeys :: VectorClock -> MetaDataOptions -> (SeekInput, Key, ActionItem) -> CommandStart
+startKeys c o (si, k, ai) = case getSet o of
 	Get f -> startingCustomOutput k $ do
 		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
 		liftIO $ forM_ l $
 			B8.putStrLn . fromMetaValue
 		next $ return True
-	_ -> starting "metadata" ai $
+	_ -> starting "metadata" ai si $
 		perform c o k
 
 perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform
@@ -170,8 +170,8 @@ parseJSONInput i = case eitherDecode (BU.fromString i) of
 			(Nothing, Nothing) -> return $ 
 				Left "JSON input is missing either file or key"
 
-startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart
-startBatch (i, (MetaData m)) = case i of
+startBatch :: (SeekInput, (Either RawFilePath Key, MetaData)) -> CommandStart
+startBatch (si, (i, (MetaData m))) = case i of
 	Left f -> do
 		mk <- lookupKey f
 		case mk of
@@ -179,7 +179,7 @@ startBatch (i, (MetaData m)) = case i of
 			Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f
 	Right k -> go k (mkActionItem k)
   where
-	go k ai = starting "metadata" ai $ do
+	go k ai = starting "metadata" ai si $ do
 		let o = MetaDataOptions
 			{ forFiles = []
 			, getSet = if MetaData m == emptyMetaData

Command/Migrate.hs

@@ -35,8 +35,8 @@ seek = withFilesInGitAnnex ww seeker <=< workTreeItems ww
 		, usesLocationLog = False
 		}
 
-start :: RawFilePath -> Key -> CommandStart
-start file key = do
+start :: SeekInput -> RawFilePath -> Key -> CommandStart
+start si file key = do
 	forced <- Annex.getState Annex.force
 	v <- Backend.getBackend (fromRawFilePath file) key
 	case v of
@@ -46,7 +46,7 @@ start file key = do
 			newbackend <- maybe defaultBackend return 
 				=<< chooseBackend (fromRawFilePath file)
 			if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists
-				then starting "migrate" (mkActionItem (key, file)) $
+				then starting "migrate" (mkActionItem (key, file)) si $
 					perform file key oldbackend newbackend
 				else stop
 

Command/Mirror.hs

@@ -57,19 +57,19 @@ seek o = startConcurrency stages $
 		, usesLocationLog = True
 		}
 
-start :: MirrorOptions -> RawFilePath -> Key -> CommandStart
-start o file k = startKey o afile (k, ai)
+start :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o si file k = startKey o afile (si, k, ai)
   where
 	afile = AssociatedFile (Just file)
 	ai = mkActionItem (k, afile)
 
-startKey :: MirrorOptions -> AssociatedFile -> (Key, ActionItem) -> CommandStart
-startKey o afile (key, ai) = case fromToOptions o of
+startKey :: MirrorOptions -> AssociatedFile -> (SeekInput, Key, ActionItem) -> CommandStart
+startKey o afile (si, key, ai) = case fromToOptions o of
 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
-		( Command.Move.toStart Command.Move.RemoveNever afile key ai =<< getParsed r
+		( Command.Move.toStart Command.Move.RemoveNever afile key ai si =<< getParsed r
 		, do
 			numcopies <- getnumcopies
-			Command.Drop.startRemote afile ai numcopies key =<< getParsed r
+			Command.Drop.startRemote afile ai si numcopies key =<< getParsed r
 		)
 	FromRemote r -> checkFailedTransferDirection ai Download $ do
 		haskey <- flip Remote.hasKey key =<< getParsed r
@@ -77,12 +77,12 @@ startKey o afile (key, ai) = case fromToOptions o of
 			Left _ -> stop
 			Right True -> ifM (inAnnex key)
 				( stop
-				, Command.Get.start' (return True) Nothing key afile ai
+				, Command.Get.start' (return True) Nothing key afile ai si
 				)
 			Right False -> ifM (inAnnex key)
 				( do
 					numcopies <- getnumcopies
-					Command.Drop.startLocal afile ai numcopies key []
+					Command.Drop.startLocal afile ai si numcopies key []
 				, stop
 				)
   where

Command/Move.hs

@@ -76,42 +76,42 @@ seek o = startConcurrency stages $ do
 		Left ToHere -> downloadStages
 	ww = WarnUnmatchLsFiles
 
-start :: FromToHereOptions -> RemoveWhen -> RawFilePath -> Key -> CommandStart
-start fromto removewhen f k = start' fromto removewhen afile k ai
+start :: FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart
+start fromto removewhen si f k = start' fromto removewhen afile si k ai
   where
 	afile = AssociatedFile (Just f)
 	ai = mkActionItem (k, afile)
 
-startKey :: FromToHereOptions -> RemoveWhen -> (Key, ActionItem) -> CommandStart
-startKey fromto removewhen = 
-	uncurry $ start' fromto removewhen (AssociatedFile Nothing)
+startKey :: FromToHereOptions -> RemoveWhen -> (SeekInput, Key, ActionItem) -> CommandStart
+startKey fromto removewhen (si, k, ai) = 
+	start' fromto removewhen (AssociatedFile Nothing) si k ai
 
-start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
-start' fromto removewhen afile key ai =
+start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> SeekInput -> Key -> ActionItem -> CommandStart
+start' fromto removewhen afile si key ai =
 	case fromto of
 		Right (FromRemote src) ->
 			checkFailedTransferDirection ai Download $
-				fromStart removewhen afile key ai =<< getParsed src
+				fromStart removewhen afile key ai si =<< getParsed src
 		Right (ToRemote dest) ->
 			checkFailedTransferDirection ai Upload $
-				toStart removewhen afile key ai =<< getParsed dest
+				toStart removewhen afile key ai si =<< getParsed dest
 		Left ToHere ->
 			checkFailedTransferDirection ai Download $
-				toHereStart removewhen afile key ai
+				toHereStart removewhen afile key ai si
 
 describeMoveAction :: RemoveWhen -> String
 describeMoveAction RemoveNever = "copy"
 describeMoveAction _ = "move"
 
-toStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-toStart removewhen afile key ai dest = do
+toStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> Remote -> CommandStart
+toStart removewhen afile key ai si dest = do
 	u <- getUUID
 	if u == Remote.uuid dest
 		then stop
-		else toStart' dest removewhen afile key ai
+		else toStart' dest removewhen afile key ai si
 
-toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toStart' dest removewhen afile key ai = do
+toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
+toStart' dest removewhen afile key ai si = do
 	fast <- Annex.getState Annex.fast
 	if fast && removewhen == RemoveNever
 		then ifM (expectedPresent dest key)
@@ -121,7 +121,7 @@ toStart' dest removewhen afile key ai = do
 		else go False (Remote.hasKey dest key)
   where
 	go fastcheck isthere =
-		starting (describeMoveAction removewhen) (OnlyActionOn key ai) $
+		starting (describeMoveAction removewhen) (OnlyActionOn key ai) si $
 			toPerform dest removewhen key afile fastcheck =<< isthere
 
 expectedPresent :: Remote -> Key -> Annex Bool
@@ -196,10 +196,10 @@ toPerform dest removewhen key afile fastcheck isthere =
 	-- to be done except for cleaning up.
 	lockfailed = next $ Command.Drop.cleanupLocal key
 
-fromStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-fromStart removewhen afile key ai src = 
+fromStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> Remote -> CommandStart
+fromStart removewhen afile key ai si src = 
 	stopUnless (fromOk src key) $
-		starting (describeMoveAction removewhen) (OnlyActionOn key ai) $
+		starting (describeMoveAction removewhen) (OnlyActionOn key ai) si $
 			fromPerform src removewhen key afile
 
 fromOk :: Remote -> Key -> Annex Bool
@@ -252,13 +252,13 @@ fromPerform src removewhen key afile = do
  -
  - When moving, the content is removed from all the reachable remotes that
  - it can safely be removed from. -}
-toHereStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toHereStart removewhen afile key ai = 
+toHereStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
+toHereStart removewhen afile key ai si = 
 	startingNoMessage (OnlyActionOn key ai) $ do
 		rs <- Remote.keyPossibilities key
 		forM_ rs $ \r ->
 			includeCommandAction $
-				starting (describeMoveAction removewhen) ai $
+				starting (describeMoveAction removewhen) ai si $
 					fromPerform r removewhen key afile
 		next $ return True
 

Command/Multicast.hs

@@ -78,7 +78,7 @@ seek (MultiCastOptions Receive ups []) = commandAction $ receive ups
 seek (MultiCastOptions Receive _ _) = giveup "Cannot specify list of files with --receive; this receives whatever files the sender chooses to send."
 
 genAddress :: CommandStart
-genAddress = starting "gen-address" (ActionItemOther Nothing) $ do
+genAddress = starting "gen-address" (ActionItemOther Nothing) (SeekInput []) $ do
 	k <- uftpKey
 	(s, ok) <- case k of
 		KeyContainer s -> liftIO $ genkey (Param s)
@@ -127,7 +127,7 @@ send ups fs = do
 	-- In a direct mode repository, the annex objects do not have
 	-- the names of keys, and would have to be copied, which is too
 	-- expensive.
-	starting "sending files" (ActionItemOther Nothing) $
+	starting "sending files" (ActionItemOther Nothing) (SeekInput []) $
 		withTmpFile "send" $ \t h -> do
 			let ww = WarnUnmatchLsFiles
 			fs' <- seekHelper id ww LsFiles.inRepo
@@ -135,7 +135,7 @@ send ups fs = do
 			matcher <- Limit.getMatcher
 			let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $
 				liftIO $ hPutStrLn h o
-			forM_ fs' $ \f -> do
+			forM_ fs' $ \(_, f) -> do
 				mk <- lookupKey f
 				case mk of
 					Nothing -> noop
@@ -166,7 +166,7 @@ send ups fs = do
 			next $ return True
 
 receive :: [CommandParam] -> CommandStart
-receive ups = starting "receiving multicast files" (ActionItemOther Nothing) $ do
+receive ups = starting "receiving multicast files" ai si $ do
 	showNote "Will continue to run until stopped by ctrl-c"
 	
 	showOutput
@@ -200,6 +200,9 @@ receive ups = starting "receiving multicast files" (ActionItemOther Nothing) $ d
 		mapM_ storeReceived . lines =<< liftIO (hGetContents statush)
 		showEndResult =<< liftIO (wait runner)
 	next $ return True
+  where
+	ai = ActionItemOther Nothing
+	si = SeekInput []
 
 storeReceived :: FilePath -> Annex ()
 storeReceived f = do

Command/NumCopies.hs

@@ -46,6 +46,9 @@ startGet = startingCustomOutput (ActionItemOther Nothing) $ next $ do
 	return True
 
 startSet :: Int -> CommandStart
-startSet n = startingUsualMessages "numcopies" (ActionItemOther (Just $ show n)) $ do
+startSet n = startingUsualMessages "numcopies" ai si $ do
 	setGlobalNumCopies $ NumCopies n
 	next $ return True
+  where
+	ai = ActionItemOther (Just $ show n)
+	si = SeekInput [show n]

Command/P2P.hs

@@ -98,9 +98,11 @@ genAddresses addrs = do
 
 -- Address is read from stdin, to avoid leaking it in shell history.
 linkRemote :: RemoteName -> CommandStart
-linkRemote remotename = starting "p2p link" (ActionItemOther (Just remotename)) $
+linkRemote remotename = starting "p2p link" ai si $
 	next promptaddr
   where
+	ai = ActionItemOther (Just remotename)
+	si = SeekInput []
 	promptaddr = do
 		liftIO $ putStrLn ""
 		liftIO $ putStr "Enter peer address: "
@@ -124,10 +126,13 @@ linkRemote remotename = starting "p2p link" (ActionItemOther (Just remotename))
 startPairing :: RemoteName -> [P2PAddress] -> CommandStart
 startPairing _ [] = giveup "No P2P networks are currrently available."
 startPairing remotename addrs = ifM (liftIO Wormhole.isInstalled)
-	( starting "p2p pair" (ActionItemOther (Just remotename)) $
+	( starting "p2p pair" ai si $
 		performPairing remotename addrs
 	, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
-	) 
+	)
+  where
+	ai = ActionItemOther (Just remotename)
+	si = SeekInput []
 
 performPairing :: RemoteName -> [P2PAddress] -> CommandPerform
 performPairing remotename addrs = do

Command/PreCommit.hs

@@ -35,8 +35,8 @@ seek ps = do
 	let ww = WarnUnmatchWorkTreeItems
 	l <- workTreeItems ww ps
 	-- fix symlinks to files being committed
-	flip withFilesToBeCommitted l $ \f -> commandAction $
-		maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)
+	flip withFilesToBeCommitted l $ \(si, f) -> commandAction $
+		maybe stop (Command.Fix.start Command.Fix.FixSymlinks si f)
 			=<< isAnnexLink f
 	-- after a merge conflict or git cherry-pick or stash, pointer
 	-- files in the worktree won't be populated, so populate them here
@@ -53,12 +53,18 @@ seek ps = do
 			(removeViewMetaData v)
 
 addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
-addViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
+addViewMetaData v f k = starting "metadata" ai si $
 	next $ changeMetaData k $ fromView v f
+  where
+	ai = mkActionItem (k, toRawFilePath f)
+	si = SeekInput []
 
 removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
-removeViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
+removeViewMetaData v f k = starting "metadata" ai si $
 	next $ changeMetaData k $ unsetMetaData $ fromView v f
+  where
+	ai = mkActionItem (k, toRawFilePath f)
+	si = SeekInput []
 
 changeMetaData :: Key -> MetaData -> CommandCleanup
 changeMetaData k metadata = do

Command/ReKey.hs

@@ -52,21 +52,25 @@ batchParser s = case separate (== ' ') (reverse s) of
 
 seek :: ReKeyOptions -> CommandSeek
 seek o = case batchOption o of
-	Batch fmt -> batchInput fmt batchParser $
-		batchCommandAction . start
-	NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
+	Batch fmt -> batchInput fmt batchParser
+		(batchCommandAction . uncurry start)
+	NoBatch -> withPairs 
+		(\(si, p) -> commandAction (start si (parsekey p))) 
+		(reKeyThese o)
   where
 	parsekey (file, skey) =
 		(toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
 
-start :: (RawFilePath, Key) -> CommandStart
-start (file, newkey) = ifAnnexed file go stop
+start :: SeekInput -> (RawFilePath, Key) -> CommandStart
+start si (file, newkey) = ifAnnexed file go stop
   where
 	go oldkey
 		| oldkey == newkey = stop
-		| otherwise = starting "rekey" (ActionItemWorkTreeFile file) $
+		| otherwise = starting "rekey" ai si $
 			perform file oldkey newkey
 
+	ai = ActionItemWorkTreeFile file
+
 perform :: RawFilePath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
 	ifM (inAnnex oldkey) 

Command/RecvKey.hs

@@ -24,8 +24,8 @@ cmd = noCommit $ command "recvkey" SectionPlumbing
 seek :: CmdParams -> CommandSeek
 seek = withKeys (commandAction . start)
 
-start :: Key -> CommandStart
-start key = fieldTransfer Download key $ \_p -> do
+start :: (SeekInput, Key) -> CommandStart
+start (_, key) = fieldTransfer Download key $ \_p -> do
 	-- Always verify content when a repo is sending an unlocked file,
 	-- as the file could change while being transferred.
 	fromunlocked <- (isJust <$> Fields.getField Fields.unlocked)

Command/RegisterUrl.hs

@@ -40,14 +40,16 @@ seek o = case (batchOption o, keyUrlPairs o) of
 
 start :: [String] -> CommandStart
 start (keyname:url:[]) = 
-	starting "registerurl" (ActionItemOther (Just url)) $ do
-		let key = keyOpt keyname
-		perform key url
+	starting "registerurl" ai si $
+		perform (keyOpt keyname) url
+  where
+	ai = ActionItemOther (Just url)
+	si = SeekInput [keyname, url]
 start _ = giveup "specify a key and an url"
 
 startMass :: BatchFormat -> CommandStart
 startMass fmt = 
-	starting "registerurl" (ActionItemOther (Just "stdin")) $
+	starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $
 		massAdd fmt
 
 massAdd :: BatchFormat -> CommandPerform

Command/Reinit.hs

@@ -24,7 +24,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start ws = starting "reinit" (ActionItemOther (Just s)) $
+start ws = starting "reinit" (ActionItemOther (Just s)) (SeekInput ws) $
 	perform s
   where
 	s = unwords ws

Command/Reinject.hs

@@ -41,20 +41,22 @@ seek os
 	| otherwise = withWords (commandAction . startSrcDest) (params os)
 
 startSrcDest :: [FilePath] -> CommandStart
-startSrcDest (src:dest:[])
+startSrcDest ps@(src:dest:[])
 	| src == dest = stop
 	| otherwise = notAnnexed src $ ifAnnexed (toRawFilePath dest) go stop
   where
-	go key = starting "reinject" (ActionItemOther (Just src)) $
+	go key = starting "reinject" ai si $
 		ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src)
 			( perform src key
 			, giveup $ src ++ " does not have expected content of " ++ dest
 			)
+	ai = ActionItemOther (Just src)
+	si = SeekInput ps
 startSrcDest _ = giveup "specify a src file and a dest file"
 
 startKnown :: FilePath -> CommandStart
 startKnown src = notAnnexed src $
-	starting "reinject" (ActionItemOther (Just src)) $ do
+	starting "reinject" ai si $ do
 		(key, _) <- genKey ks nullMeterUpdate Nothing
 		ifM (isKnownKey key)
 			( perform src key
@@ -65,6 +67,8 @@ startKnown src = notAnnexed src $
   where
 	ks = KeySource src' src' Nothing
 	src' = toRawFilePath src
+	ai = ActionItemOther (Just src)
+	si = SeekInput [src]
 
 notAnnexed :: FilePath -> CommandStart -> CommandStart
 notAnnexed src a = 

Command/RenameRemote.hs

@@ -27,7 +27,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case
+start ps@(oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case
 	Just (u, cfg, mcu) -> Annex.SpecialRemote.findExisting newname >>= \case
 		Just _ -> giveup $ "The name " ++ newname ++ " is already used by a special remote."
 		Nothing -> go u cfg mcu
@@ -42,8 +42,9 @@ start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case
 				Nothing -> giveup "That is not a special remote."
 				Just cfg -> go u cfg Nothing
   where
-	go u cfg mcu = starting "rename" (ActionItemOther Nothing) $
-		perform u cfg mcu newname
+	ai = ActionItemOther Nothing
+	si = SeekInput ps
+	go u cfg mcu = starting "rename" ai si $ perform u cfg mcu newname
 start _ = giveup "Specify an old name (or uuid or description) and a new name."
 
 perform :: UUID -> R.RemoteConfig -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> String -> CommandPerform

Command/Repair.hs

@@ -25,7 +25,7 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing (commandAction start)
 
 start :: CommandStart
-start = starting "repair" (ActionItemOther Nothing) $ 
+start = starting "repair" (ActionItemOther Nothing) (SeekInput []) $ 
 	next $ runRepair =<< Annex.getState Annex.force
 
 runRepair :: Bool -> Annex Bool

Command/ResolveMerge.hs

@@ -24,7 +24,7 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing (commandAction start)
 
 start :: CommandStart
-start = starting "resolvemerge" (ActionItemOther Nothing) $ do
+start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
 	us <- fromMaybe nobranch <$> inRepo Git.Branch.current
 	d <- fromRawFilePath <$> fromRepo Git.localGitDir
 	let merge_head = d </> "MERGE_HEAD"

Command/RmUrl.hs

@@ -30,8 +30,7 @@ optParser desc = RmUrlOptions
 
 seek :: RmUrlOptions -> CommandSeek
 seek o = case batchOption o of
-	Batch fmt -> batchInput fmt batchParser
-		(batchCommandAction . start)
+	Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
 	NoBatch -> withPairs (commandAction . start) (rmThese o)
 
 -- Split on the last space, since a FilePath can contain whitespace,
@@ -45,9 +44,10 @@ batchParser s = case separate (== ' ') (reverse s) of
 			f' <- liftIO $ relPathCwdToFile f
 			return $ Right (f', reverse ru)
 
-start :: (FilePath, URLString) -> CommandStart
-start (file, url) = flip whenAnnexed file' $ \_ key ->
-	starting "rmurl" (mkActionItem (key, AssociatedFile (Just file'))) $
+start :: (SeekInput, (FilePath, URLString)) -> CommandStart
+start (si, (file, url)) = flip whenAnnexed file' $ \_ key -> do
+	let ai = mkActionItem (key, AssociatedFile (Just file'))
+	starting "rmurl" ai si $
 		next $ cleanup url key
   where
 	file' = toRawFilePath file

Command/Schedule.hs

@@ -29,9 +29,11 @@ start = parse
 		u <- Remote.nameToUUID name
 		startingCustomOutput (ActionItemOther Nothing) $
 			performGet u
-	parse (name:expr:[]) = do
+	parse ps@(name:expr:[]) = do
 		u <- Remote.nameToUUID name
-		startingUsualMessages "schedule" (ActionItemOther (Just name)) $
+		let ai = ActionItemOther (Just name)
+		let si = SeekInput ps
+		startingUsualMessages "schedule" ai si $
 			performSet expr u
 	parse _ = giveup "Specify a repository."
 

Command/SendKey.hs

@@ -26,8 +26,8 @@ cmd = noCommit $
 seek :: CmdParams -> CommandSeek
 seek = withKeys (commandAction . start)
 
-start :: Key -> CommandStart
-start key = do
+start :: (SeekInput, Key) -> CommandStart
+start (_, key) = do
 	opts <- filterRsyncSafeOptions . maybe [] words
 		<$> getField "RsyncOptions"
 	ifM (inAnnex key)

Command/SetKey.hs

@@ -20,8 +20,11 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start (keyname:file:[]) = starting "setkey" (ActionItemOther (Just file)) $
+start ps@(keyname:file:[]) = starting "setkey" ai si $
 	perform file (keyOpt keyname)
+  where
+	ai = ActionItemOther (Just file)
+	si = SeekInput ps
 start _ = giveup "specify a key and a content file"
 
 keyOpt :: String -> Key

Command/SetPresentKey.hs

@@ -32,8 +32,8 @@ seek :: SetPresentKeyOptions -> CommandSeek
 seek o = case batchOption o of
 	Batch fmt -> batchInput fmt
 		(pure . parseKeyStatus . words)
-		(batchCommandAction . start)
-	NoBatch -> either giveup (commandAction . start)
+		(batchCommandAction . uncurry start)
+	NoBatch -> either giveup (commandAction . start (SeekInput (params o)))
 		(parseKeyStatus $ params o)
 
 data KeyStatus = KeyStatus Key UUID LogStatus
@@ -46,9 +46,10 @@ parseKeyStatus (ks:us:vs:[]) = do
 	return $ KeyStatus k u s
 parseKeyStatus _ = Left "Bad input. Expected: key uuid value"
 
-start :: KeyStatus -> CommandStart
-start (KeyStatus k u s) = starting "setpresentkey" (mkActionItem k) $
-	perform k u s
+start :: SeekInput -> KeyStatus -> CommandStart
+start si (KeyStatus k u s) = starting "setpresentkey" ai si $ perform k u s
+  where
+	ai = mkActionItem k
 
 perform :: Key -> UUID -> LogStatus -> CommandPerform
 perform k u s = next $ do

Command/Sync.hs

@@ -308,7 +308,7 @@ syncRemotes' ps available =
 	fastest = fromMaybe [] . headMaybe . Remote.byCost
 
 commit :: SyncOptions -> CommandStart
-commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing) $ do
+commit o = stopUnless shouldcommit $ starting "commit" ai si $ do
 	commitmessage <- maybe commitMsg return (messageOption o)
 	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	next $ do
@@ -324,6 +324,8 @@ commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing)
 		( pure (commitOption o)
 		<||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit)
 		)
+	ai = ActionItemOther Nothing
+	si = SeekInput []
 
 commitMsg :: Annex String
 commitMsg = do
@@ -350,14 +352,18 @@ mergeLocal' :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandSt
 mergeLocal' mergeconfig o currbranch@(Just branch, _) =
 	needMerge currbranch branch >>= \case
 		Nothing -> stop
-		Just syncbranch ->
-			starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $
+		Just syncbranch -> do
+			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let si = SeekInput []
+			starting "merge" ai si $
 				next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
 mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \case
 	Just branch -> needMerge currbranch branch >>= \case
 		Nothing -> stop
-		Just syncbranch ->
-			starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $ do
+		Just syncbranch -> do
+			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let si = SeekInput []
+			starting "merge" ai si $ do
 				warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
 				next $ return False
 	Nothing -> stop
@@ -421,7 +427,7 @@ updateBranch syncbranch updateto g =
 
 pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart
 pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $
-	starting "pull" (ActionItemOther (Just (Remote.name remote))) $ do
+	starting "pull" ai si $ do
 		showOutput
 		ifM (onlyAnnex o)
 			( do
@@ -443,6 +449,8 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
 				[Param "fetch", Param $ Remote.name remote]
 					++ map Param bs
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
+	ai = ActionItemOther (Just (Remote.name remote))
+	si = SeekInput []
 
 importRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek
 importRemote o mergeconfig remote currbranch
@@ -489,7 +497,7 @@ pushRemote o remote (Just branch, _) = do
 	onlyannex <- onlyAnnex o
 	let mainbranch = if onlyannex then Nothing else Just branch
 	stopUnless (pure (pushOption o) <&&> needpush mainbranch) $
-		starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do
+		starting "push" ai si $ next $ do
 			repo <- Remote.getRepo remote
 			showOutput
 			ok <- inRepoWithSshOptionsTo repo gc $
@@ -500,6 +508,8 @@ pushRemote o remote (Just branch, _) = do
 					warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
 					return ok
   where
+	ai = ActionItemOther (Just (Remote.name remote))
+	si = SeekInput []
 	gc = Remote.gitconfig remote
 	needpush mainbranch
 		| remoteAnnexReadOnly gc = return False
@@ -663,15 +673,15 @@ seekSyncContent o rs currbranch = do
 			seekHelper fst3 ww LsFiles.inRepoDetails l
 
 	seekincludinghidden origbranch mvar l bloomfeeder =
-		seekFiltered (\f -> ifAnnexed f (commandAction . gofile bloomfeeder mvar f) noop) $
+		seekFiltered (\(si, f) -> ifAnnexed f (commandAction . gofile bloomfeeder mvar si f) noop) $
 			seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l 
 
 	ww = WarnUnmatchLsFiles
 
-	gofile bloom mvar f k = 
+	gofile bloom mvar _ f k = 
 		go (Right bloom) mvar (AssociatedFile (Just f)) k
 	
-	gokey mvar bloom (k, _) =
+	gokey mvar bloom (_, k, _) =
 		go (Left bloom) mvar (AssociatedFile Nothing) k
 
 	go ebloom mvar af k = do
@@ -725,7 +735,7 @@ syncFile ebloom rs af k = do
 		-- includeCommandAction for drops,
 		-- because a failure to drop does not mean
 		-- the sync failed.
-		handleDropsFrom locs' rs "unwanted" True k af []
+		handleDropsFrom locs' rs "unwanted" True k af si []
 			callCommandAction
 	
 	return (got || not (null putrs))
@@ -739,7 +749,7 @@ syncFile ebloom rs af k = do
 		( return [ get have ]
 		, return []
 		)
-	get have = includeCommandAction $ starting "get" ai $
+	get have = includeCommandAction $ starting "get" ai si $
 		stopUnless (getKey' k af have) $
 			next $ return True
 
@@ -755,9 +765,10 @@ syncFile ebloom rs af k = do
 		, return []
 		)
 	put dest = includeCommandAction $ 
-		Command.Move.toStart' dest Command.Move.RemoveNever af k ai
+		Command.Move.toStart' dest Command.Move.RemoveNever af k ai si
 
 	ai = mkActionItem (k, af)
+	si = SeekInput []
 
 {- When a remote has an annex-tracking-branch configuration, change the export
  - to contain the current content of the branch. Otherwise, transfer any files
@@ -814,22 +825,21 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 
 cleanupLocal :: CurrBranch -> CommandStart
 cleanupLocal (Nothing, _) = stop
-cleanupLocal (Just currb, _) = 
-	starting "cleanup" (ActionItemOther (Just "local")) $ 
-		next $ do
-			delbranch $ syncBranch currb
-			delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
-			mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r)
-				=<< listTaggedBranches
-			return True
+cleanupLocal (Just currb, _) = starting "cleanup" ai si $ next $ do
+	delbranch $ syncBranch currb
+	delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
+	mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r) =<< listTaggedBranches
+	return True
   where
 	delbranch b = whenM (inRepo $ Git.Ref.exists $ Git.Ref.branchRef b) $
 		inRepo $ Git.Branch.delete b
+	ai = ActionItemOther (Just "local")
+	si = SeekInput []
 
 cleanupRemote :: Remote -> CurrBranch -> CommandStart
 cleanupRemote _ (Nothing, _) = stop
 cleanupRemote remote (Just b, _) =
-	starting "cleanup" (ActionItemOther (Just (Remote.name remote))) $
+	starting "cleanup" ai si $
 		next $ inRepo $ Git.Command.runBool
 			[ Param "push"
 			, Param "--quiet"
@@ -839,7 +849,10 @@ cleanupRemote remote (Just b, _) =
 			, Param $ Git.fromRef $ syncBranch $
 				Git.Ref.base $ Annex.Branch.name
 			]
-  
+  where
+	ai = ActionItemOther (Just (Remote.name remote))
+	si = SeekInput []
+
 shouldSyncContent :: SyncOptions -> Annex Bool
 shouldSyncContent o
 	| noContentOption o = pure False

Command/TestRemote.hs

@@ -73,7 +73,7 @@ seek :: TestRemoteOptions -> CommandSeek
 seek = commandAction . start 
 
 start :: TestRemoteOptions -> CommandStart
-start o = starting "testremote" (ActionItemOther (Just (testRemote o))) $ do
+start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
 	fast <- Annex.getState Annex.fast
 	cache <- liftIO newRemoteVariantCache
 	r <- either giveup (disableExportTree cache)
@@ -98,6 +98,7 @@ start o = starting "testremote" (ActionItemOther (Just (testRemote o))) $ do
 	perform drs unavailr exportr ks
   where
 	basesz = fromInteger $ sizeOption o
+	si = SeekInput [testRemote o]
 
 perform :: [Described (Annex (Maybe Remote))] -> Maybe Remote -> Annex (Maybe Remote) -> [Key] -> CommandPerform
 perform drs unavailr exportr ks = do

Command/TransferKey.hs

@@ -44,8 +44,8 @@ instance DeferredParseClass TransferKeyOptions where
 seek :: TransferKeyOptions -> CommandSeek
 seek o = withKeys (commandAction . start o) (keyOptions o)
 
-start :: TransferKeyOptions -> Key -> CommandStart
-start o key = startingCustomOutput key $ case fromToOptions o of
+start :: TransferKeyOptions -> (SeekInput, Key) -> CommandStart
+start o (_, key) = startingCustomOutput key $ case fromToOptions o of
 	ToRemote dest -> toPerform key (fileOption o) =<< getParsed dest
 	FromRemote src -> fromPerform key (fileOption o) =<< getParsed src
 

Command/Trust.hs

@@ -28,7 +28,8 @@ trustCommand c level = withWords (commandAction . start)
 	start ws = do
 		let name = unwords ws
 		u <- Remote.nameToUUID name
-		starting c (ActionItemOther (Just name)) (perform u)
+		let si = SeekInput ws
+		starting c (ActionItemOther (Just name)) si (perform u)
 	perform uuid = do
 		trustSet uuid level
 		when (level == DeadTrusted) $

Command/Unannex.hs

@@ -33,9 +33,9 @@ seeker = AnnexedFileSeeker
 	, usesLocationLog = False
 	}
 
-start :: RawFilePath -> Key -> CommandStart
-start file key = 
-	starting "unannex" (mkActionItem (key, file)) $
+start :: SeekInput -> RawFilePath -> Key -> CommandStart
+start si file key = 
+	starting "unannex" (mkActionItem (key, file)) si $
 		perform file key
 
 perform :: RawFilePath -> Key -> CommandPerform

Command/Undo.hs

@@ -41,8 +41,11 @@ seek ps = do
 	withStrings (commandAction . start) ps
 
 start :: FilePath -> CommandStart
-start p = starting "undo" (ActionItemOther (Just p)) $
+start p = starting "undo" ai si $
 	perform p
+  where
+	ai = ActionItemOther (Just p)
+	si = SeekInput [p]
 
 perform :: FilePath -> CommandPerform
 perform p = do

Command/Ungroup.hs

@@ -24,7 +24,7 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (name:g:[]) = do
 	u <- Remote.nameToUUID name
-	starting "ungroup" (ActionItemOther (Just name)) $
+	starting "ungroup" (ActionItemOther (Just name)) (SeekInput [name, g]) $
 		perform u (toGroup g)
 start _ = giveup "Specify a repository and a group."
 

Command/Uninit.hs

@@ -42,7 +42,7 @@ check = do
 seek :: CmdParams -> CommandSeek
 seek ps = do
 	l <- workTreeItems ww ps
-	withFilesNotInGit (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l
+	withFilesNotInGit WarnUnmatchWorkTreeItems (\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f) l
 	Annex.changeState $ \s -> s { Annex.fast = True }
 	withFilesInGitAnnex ww Command.Unannex.seeker l
 	finish

Command/Unlock.hs

@@ -36,12 +36,13 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
 		, usesLocationLog = False
 		}
 
-start :: RawFilePath -> Key -> CommandStart
-start file key = ifM (isJust <$> isAnnexLink file)
-	( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $
-		perform file key
+start :: SeekInput -> RawFilePath -> Key -> CommandStart
+start si file key = ifM (isJust <$> isAnnexLink file)
+	( starting "unlock" ai si $ perform file key
 	, stop
 	)
+  where
+	ai = mkActionItem (key, AssociatedFile (Just file))
 
 perform :: RawFilePath -> Key -> CommandPerform
 perform dest key = do

Command/Unused.hs

@@ -73,7 +73,7 @@ start o = do
 		Just "." -> (".", checkUnused refspec)
 		Just "here" -> (".", checkUnused refspec)
 		Just n -> (n, checkRemoteUnused n refspec)
-	starting "unused" (ActionItemOther (Just name)) perform
+	starting "unused" (ActionItemOther (Just name)) (SeekInput []) perform
 
 checkUnused :: RefSpec -> CommandPerform
 checkUnused refspec = chain 0
@@ -337,4 +337,5 @@ startUnused message unused badunused tmpunused maps n = search
 			Nothing -> search rest
 			Just key -> starting message
 				(ActionItemOther $ Just $ show n)
+				(SeekInput [])
 				(a key)

Command/Upgrade.hs

@@ -39,10 +39,10 @@ seek o = commandAction (start o)
 
 start :: UpgradeOptions -> CommandStart
 start (UpgradeOptions { autoOnly = True }) = do
-	starting "upgrade" (ActionItemOther Nothing) $ do
+	starting "upgrade" (ActionItemOther Nothing) (SeekInput []) $ do
 	getVersion >>= maybe noop checkUpgrade
 	next $ return True
-start _ = starting "upgrade" (ActionItemOther Nothing) $ do
+start _ = starting "upgrade" (ActionItemOther Nothing) (SeekInput []) $ do
 	whenM (isNothing <$> getVersion) $ do
 		initialize Nothing Nothing
 	r <- upgrade False latestVersion

Command/VAdd.hs

@@ -22,7 +22,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start params = starting "vadd" (ActionItemOther Nothing) $ 
+start params = starting "vadd" (ActionItemOther Nothing) (SeekInput params) $ 
 	withCurrentView $ \view -> do
 		let (view', change) = refineView view $
 			map parseViewParam $ reverse params

Command/VCycle.hs

@@ -26,7 +26,7 @@ start ::CommandStart
 start = go =<< currentView
   where
 	go Nothing = giveup "Not in a view."
-	go (Just v) = starting "vcycle" (ActionItemOther Nothing) $ do
+	go (Just v) = starting "vcycle" (ActionItemOther Nothing) (SeekInput [])$ do
 		let v' = v { viewComponents = vcycle [] (viewComponents v) }
 		if v == v'
 			then do

Command/VFilter.hs

@@ -20,7 +20,7 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start params = starting "vfilter" (ActionItemOther Nothing) $
+start params = starting "vfilter" (ActionItemOther Nothing) (SeekInput params) $
 	withCurrentView $ \view -> do
 		let view' = filterView view $
 			map parseViewParam $ reverse params

Command/VPop.hs

@@ -27,7 +27,7 @@ start :: [String] -> CommandStart
 start ps = go =<< currentView
   where
 	go Nothing = giveup "Not in a view."
-	go (Just v) = starting "vpop" (ActionItemOther (Just $ show num)) $ do
+	go (Just v) = starting "vpop" ai si $ do
 		removeView v
 		(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v)
 			<$> recentViews
@@ -46,3 +46,7 @@ start ps = go =<< currentView
 	sameparentbranch a b = viewParentBranch a == viewParentBranch b
 
 	num = fromMaybe 1 $ readish =<< headMaybe ps 
+	
+	ai = ActionItemOther (Just $ show num)
+	
+	si = SeekInput ps

Command/View.hs

@@ -36,7 +36,9 @@ start ps = ifM safeToEnterView
 	, giveup "Not safe to enter view."
 	)
   where
-	go view Nothing = starting "view" (ActionItemOther Nothing) $
+	ai = ActionItemOther Nothing
+	si = SeekInput ps
+	go view Nothing = starting "view" ai si $
 		perform view
 	go view (Just v)
 		| v == view = stop

Command/Wanted.hs

@@ -36,9 +36,11 @@ cmd' name desc getter setter = noMessages $
 		u <- Remote.nameToUUID rname
 		startingCustomOutput (ActionItemOther Nothing) $
 			performGet getter u
-	start (rname:expr:[]) = do
+	start ps@(rname:expr:[]) = do
 		u <- Remote.nameToUUID rname
-		startingUsualMessages name (ActionItemOther (Just rname)) $
+		let si = SeekInput ps
+		let ai = ActionItemOther (Just rname)
+		startingUsualMessages name ai si $
 			performSet setter expr u
 	start _ = giveup "Specify a repository."
 

Command/Whereis.hs

@@ -66,16 +66,16 @@ seek o = do
   where
 	ww = WarnUnmatchLsFiles
 
-start :: WhereisOptions -> M.Map UUID Remote -> RawFilePath -> Key -> CommandStart
-start o remotemap file key = 
-	startKeys o remotemap (key, mkActionItem (key, afile))
+start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
+start o remotemap si file key = 
+	startKeys o remotemap (si, key, mkActionItem (key, afile))
   where
 	afile = AssociatedFile (Just file)
 
-startKeys :: WhereisOptions -> M.Map UUID Remote -> (Key, ActionItem) -> CommandStart
-startKeys o remotemap (key, ai)
+startKeys :: WhereisOptions -> M.Map UUID Remote -> (SeekInput, Key, ActionItem) -> CommandStart
+startKeys o remotemap (si, key, ai)
 	| isJust (formatOption o) = startingCustomOutput ai go
-	| otherwise = starting "whereis" ai go
+	| otherwise = starting "whereis" ai si go
   where
 	go = perform o remotemap key ai
 

Config/GitConfig.hs

@@ -20,13 +20,13 @@ import Logs.Config
  - Note: Be sure to add the config to mergeGitConfig and to
  - globalConfigs.
  -}
-getGitConfigVal :: (GitConfig -> Configurable a) -> Annex a
+getGitConfigVal :: (GitConfig -> GlobalConfigurable a) -> Annex a
 getGitConfigVal f = getGitConfigVal' f >>= \case
 	HasGlobalConfig c -> return c
 	DefaultConfig d -> return d
 	HasGitConfig c -> return c
 
-getGitConfigVal' :: (GitConfig -> Configurable a) -> Annex (Configurable a)
+getGitConfigVal' :: (GitConfig -> GlobalConfigurable a) -> Annex (GlobalConfigurable a)
 getGitConfigVal' f = (f <$> Annex.getGitConfig) >>= \case
 	DefaultConfig _ -> do
 		r <- Annex.gitRepo

Messages.hs

@@ -9,7 +9,7 @@
 
 module Messages (
 	showStart,
-	showStart',
+	showStartOther,
 	showStartMessage,
 	showEndMessage,
 	StartMessage(..),
@@ -64,45 +64,46 @@ import Types
 import Types.Messages
 import Types.ActionItem
 import Types.Concurrency
-import Types.Command (StartMessage(..))
+import Types.Command (StartMessage(..), SeekInput)
 import Types.Transfer (transferKey)
 import Messages.Internal
 import Messages.Concurrent
+import Annex.Concurrent.Utility
 import qualified Messages.JSON as JSON
 import qualified Annex
 
-showStart :: String -> RawFilePath -> Annex ()
-showStart command file = outputMessage json $
+showStart :: String -> RawFilePath -> SeekInput -> Annex ()
+showStart command file si = outputMessage json $
 	encodeBS' command <> " " <> file <> " "
   where
-	json = JSON.start command (Just file) Nothing
+	json = JSON.start command (Just file) Nothing si
 
-showStart' :: String -> Maybe String -> Annex ()
-showStart' command mdesc = outputMessage json $ encodeBS' $
+showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
+showStartKey command key ai si = outputMessage json $
+	encodeBS' command <> " " <> actionItemDesc ai <> " "
+  where
+	json = JSON.start command (actionItemWorkTreeFile ai) (Just key) si
+
+showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
+showStartOther command mdesc si = outputMessage json $ encodeBS' $
 	command ++ (maybe "" (" " ++) mdesc) ++ " "
   where
-	json = JSON.start command Nothing Nothing
-
-showStartKey :: String -> Key -> ActionItem -> Annex ()
-showStartKey command key i = outputMessage json $
-	encodeBS' command <> " " <> actionItemDesc i <> " "
-  where
-	json = JSON.start command (actionItemWorkTreeFile i) (Just key)
+	json = JSON.start command Nothing Nothing si
 
 showStartMessage :: StartMessage -> Annex ()
-showStartMessage (StartMessage command ai) = case ai of
-	ActionItemAssociatedFile _ k -> showStartKey command k ai
-	ActionItemKey k -> showStartKey command k ai
-	ActionItemBranchFilePath _ k -> showStartKey command k ai
-	ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai
-	ActionItemWorkTreeFile file -> showStart command file
-	ActionItemOther msg -> showStart' command msg
-	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai')
-showStartMessage (StartUsualMessages command ai) = do
+showStartMessage (StartMessage command ai si) = case ai of
+	ActionItemAssociatedFile _ k -> showStartKey command k ai si
+	ActionItemKey k -> showStartKey command k ai si
+	ActionItemBranchFilePath _ k -> showStartKey command k ai si
+	ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si
+	ActionItemWorkTreeFile file -> showStart command file si
+	ActionItemOther msg -> showStartOther command msg si
+	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
+showStartMessage (StartUsualMessages command ai si) = do
 	outputType <$> Annex.getState Annex.output >>= \case
 		QuietOutput -> Annex.setOutput NormalOutput
 		_ -> noop
-	showStartMessage (StartMessage command ai)
+	showStartMessage (StartMessage command ai si)
 showStartMessage (StartNoMessage _) = noop
 showStartMessage (CustomOutput _) =
 	outputType <$> Annex.getState Annex.output >>= \case
@@ -111,8 +112,8 @@ showStartMessage (CustomOutput _) =
 
 -- Only show end result if the StartMessage is one that gets displayed.
 showEndMessage :: StartMessage -> Bool -> Annex ()
-showEndMessage (StartMessage _ _) = showEndResult
-showEndMessage (StartUsualMessages _ _) = showEndResult
+showEndMessage (StartMessage _ _ _) = showEndResult
+showEndMessage (StartUsualMessages _ _ _) = showEndResult
 showEndMessage (StartNoMessage _) = const noop
 showEndMessage (CustomOutput _) = const noop
 
@@ -238,9 +239,9 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)
  - a complete JSON document.
  - This is only needed when showStart and showEndOk is not used.
  -}
-showCustom :: String -> Annex Bool -> Annex ()
-showCustom command a = do
-	outputMessage (JSON.start command Nothing Nothing) ""
+showCustom :: String -> SeekInput -> Annex Bool -> Annex ()
+showCustom command si a = do
+	outputMessage (JSON.start command Nothing Nothing si) ""
 	r <- a
 	outputMessage (JSON.end r) ""
 
@@ -298,7 +299,7 @@ prompt a = do
 
 {- Like prompt, but for a non-annex action that prompts. -}
 mkPrompter :: (MonadMask m, MonadIO m) => Annex (m a -> m a)
-mkPrompter = Annex.getState Annex.concurrency >>= \case
+mkPrompter = getConcurrency >>= \case
 	NonConcurrent -> return id
 	(Concurrent _) -> goconcurrent
 	ConcurrentPerCpu -> goconcurrent

Messages/JSON.hs

@@ -1,6 +1,6 @@
 {- git-annex command-line JSON output and input
  -
- - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -39,6 +39,7 @@ import Data.Monoid
 import Prelude
 
 import Types.Messages
+import Types.Command (SeekInput(..))
 import Key
 import Utility.Metered
 import Utility.Percentage
@@ -64,8 +65,8 @@ type JSONBuilder = Maybe (Object, Bool) -> Maybe (Object, Bool)
 none :: JSONBuilder
 none = id
 
-start :: String -> Maybe RawFilePath -> Maybe Key -> JSONBuilder
-start command file key _ = case j of
+start :: String -> Maybe RawFilePath -> Maybe Key -> SeekInput -> JSONBuilder
+start command file key si _ = case j of
 	Object o -> Just (o, False)
 	_ -> Nothing
   where
@@ -74,6 +75,7 @@ start command file key _ = case j of
 		, itemKey = key
 		, itemFile = fromRawFilePath <$> file
 		, itemAdded = Nothing
+		, itemSeekInput = si
 		}
 
 end :: Bool -> JSONBuilder
@@ -176,6 +178,7 @@ data JSONActionItem a = JSONActionItem
 	, itemKey :: Maybe Key
 	, itemFile :: Maybe FilePath
 	, itemAdded :: Maybe a -- for additional fields added by `add`
+	, itemSeekInput :: SeekInput
 	}
 	deriving (Show)
 
@@ -183,10 +186,11 @@ instance ToJSON' (JSONActionItem a) where
 	toJSON' i = object $ catMaybes
 		[ Just $ "command" .= itemCommand i
 		, case itemKey i of
-			Nothing -> Nothing
 			Just k -> Just $ "key" .= toJSON' k
+			Nothing -> Nothing
 		, Just $ "file" .= toJSON' (itemFile i)
 		-- itemAdded is not included; must be added later by 'add'
+		, Just $ "input" .= fromSeekInput (itemSeekInput i)
 		]
 
 instance FromJSON a => FromJSON (JSONActionItem a) where
@@ -195,6 +199,7 @@ instance FromJSON a => FromJSON (JSONActionItem a) where
 		<*> (maybe (return Nothing) parseJSON =<< (v .:? "key"))
 		<*> (v .:? "file")
 		<*> parseadded
+		<*> pure (SeekInput [])
 	  where
 		parseadded = (Just <$> parseJSON (Object v)) <|> return Nothing
 	parseJSON _ = mempty

Types/Command.hs

@@ -38,13 +38,18 @@ type CommandPerform = Annex (Maybe CommandCleanup)
  -    returns the overall success/fail of the command. -}
 type CommandCleanup = Annex Bool
 
+{- Input that was seeked on to make an ActionItem. Eg, the input filename,
+ - or directory name. -}
+newtype SeekInput = SeekInput { fromSeekInput :: [String] }
+	deriving (Show)
+
 {- Message that is displayed when starting to perform an action on
  - something. The String is typically the name of the command or action
  - being performed.
  -}
 data StartMessage
-	= StartMessage String ActionItem
-	| StartUsualMessages String ActionItem
+	= StartMessage String ActionItem SeekInput
+	| StartUsualMessages String ActionItem SeekInput
 	-- ^ Like StartMessage, but makes sure to enable usual message
 	-- display in case it was disabled by cmdnomessages.
 	| StartNoMessage ActionItem
@@ -56,8 +61,8 @@ data StartMessage
 	deriving (Show)
 
 instance MkActionItem StartMessage where
-	mkActionItem (StartMessage _ ai) = ai
-	mkActionItem (StartUsualMessages _ ai) = ai
+	mkActionItem (StartMessage _ ai _) = ai
+	mkActionItem (StartUsualMessages _ ai _) = ai
 	mkActionItem (StartNoMessage ai) = ai
 	mkActionItem (CustomOutput ai) = ai