add SeekInput (not yet used)

No behavior changes (hopefully), just adding SeekInput and plumbing it
through to the JSON display code for later use.

Over the course of 2 grueling days.

withFilesNotInGit reimplemented in terms of seekHelper
should be the only possible behavior change. It seems to test as
behaving the same.

Note that seekHelper dummies up the SeekInput in the case where
segmentPaths' gives up on sorting the expanded paths because there are
too many input paths. When SeekInput later gets exposed as a json field,
that will result in it being a little bit wrong in the case where
100 or more paths are passed to a git-annex command. I think this is a
subtle enough problem to not matter. If it does turn out to be a
problem, fixing it would require splitting up the input
parameters into groups of < 100, which would make git ls-files run
perhaps more than is necessary. May want to revisit this, because that
fix seems fairly low-impact.

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 :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> SeekInput -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex ()
-handleDropsFrom locs rs reason fromhere key afile preverified runner = do
+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

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/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,3 +1,10 @@
+git-annex (8.20200909) UNRELEASED; urgency=medium
+
+  * --json output now includes a new field "input" which is the input
+    (filename, url, etc) that caused that json to be output.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 14 Sep 2020 13:13:10 -0400
+
 git-annex (8.20200908) upstream; urgency=medium
 
   * Added httpalso special remote, which is useful for accessing 

CmdLine/Batch.hs

@@ -42,7 +42,7 @@ 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
+batchable :: (opts -> SeekInput -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
 batchable handler parser paramdesc = batchseeker <$> batchparser
   where
 	batchparser = (,,)
@@ -51,12 +51,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 =
+	go batchmode opts (si, p) =
-		unlessM (handler opts p) $
+		unlessM (handler opts si p) $
 			batchBadInput batchmode
 
 -- bad input is indicated by an empty line in batch mode. In non batch
@@ -72,12 +72,12 @@ 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
 
@@ -107,28 +107,29 @@ batchCommandAction a = maybe (batchBadInput (Batch BatchLine)) (const noop)
 -- Absolute filepaths are converted to relative.
 --
 -- File matching options are not checked.
-batchStart :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()
+batchStart :: BatchFormat -> (SeekInput -> FilePath -> CommandStart) -> Annex ()
 batchStart fmt a = batchInput fmt (Right <$$> liftIO . relPathCwdToFile) $
-	batchCommandAction . a
+	batchCommandAction . uncurry a
 
 -- Like batchStart, but checks the file matching options
 -- and skips non-matching files.
-batchFilesMatching :: BatchFormat -> (RawFilePath -> CommandStart) -> Annex ()
+batchFilesMatching :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()
 batchFilesMatching fmt a = do
 	matcher <- getMatcher
-	batchStart fmt $ \f ->
+	batchStart fmt $ \si f ->
 		let f' = toRawFilePath f
 		in ifM (matcher $ MatchingFile $ FileInfo f' f')
-			( a f'
+			( a (si, f')
 			, return Nothing
 			)
 
 batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex ()
-batchAnnexedFilesMatching fmt seeker = batchFilesMatching fmt $
+batchAnnexedFilesMatching fmt seeker = batchFilesMatching fmt $ \(si, bf) ->
-	whenAnnexed $ \f k -> case checkContentPresent seeker of
+	flip whenAnnexed bf $ \f k -> 
-		Just v -> do
+		case checkContentPresent seeker of
-			present <- inAnnex k
+			Just v -> do
-			if present == v
+				present <- inAnnex k
-				then startAction seeker f k
+				if present == v
-				else return Nothing
+					then startAction seeker si f k
-		Nothing -> startAction seeker f k
+					else return Nothing
+			Nothing -> startAction seeker si f k

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 :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
-withFilesNotInGit a (WorkTreeItems l) = go =<< seek
+withFilesNotInGit ww a l = do
-  where
+	force <- Annex.getState Annex.force
-	seek = do
+	seekFiltered a $
-		force <- Annex.getState Annex.force
+		seekHelper id ww (const $ LsFiles.notInRepo [] force) l
-		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 
 
 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 :: ((SeekInput, (String, String)) -> CommandSeek) -> CmdParams -> CommandSeek
-withPairs a params = sequence_ $ map a $ pairs [] params
+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 :: ((SeekInput, Key) -> CommandSeek) -> CmdParams -> CommandSeek
-withKeys a l = sequence_ $ map (a . parse) l
+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 =
+	process matcher v@(_si, f) =
-		whenM (matcher $ MatchingFile $ FileInfo f f) $ a 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)
+						then liftIO $ mdfeeder ((si, f), sha)
-						else feedmatches matcher ofeeder 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:: MkActionItem actionitem => String -> actionitem -> SeekInput -> CommandPerform -> CommandStart
-starting msg t a = next (StartMessage msg (mkActionItem t), a)
+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 :: MkActionItem t => String -> t -> SeekInput -> CommandPerform -> CommandStart
-startingUsualMessages msg t a = next (StartUsualMessages msg (mkActionItem t), a)
+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 True -> start si file addunlockedmatcher
-		Just False -> startSmallOverridden file
+		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 :: SeekInput -> RawFilePath -> CommandStart
-startSmall file = starting "add" (ActionItemWorkTreeFile file) $
+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 :: SeekInput -> RawFilePath -> CommandStart
-startSmallOverridden file = starting "add" (ActionItemWorkTreeFile file) $
+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 :: SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart
-start file addunlockedmatcher = do
+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
+			then void $ commandAction $
-			else checkUrl addunlockedmatcher r o' u
+				startWeb addunlockedmatcher o' si u
-	forM_ (addUrls o) (\u -> go (o, 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 -> Remote -> AddUrlOptions -> SeekInput -> URLString -> Annex ()
-checkUrl addunlockedmatcher r o u = do
+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 -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
-startRemote addunlockedmatcher r o file uri sz = do
+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 -> AddUrlOptions -> SeekInput -> URLString -> CommandStart
-startWeb addunlockedmatcher o urlstring = go $ fromMaybe bad $ parseURI urlstring
+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 :: SeekInput -> URLString -> AddUrlOptions -> CommandPerform -> CommandStart
-startingAddUrl url o p = starting "addurl" (ActionItemOther (Just url)) $ do
+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 :: () -> SeekInput -> String -> Annex Bool
-run _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
+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

@@ -20,7 +20,7 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing (commandAction start)
 
 start :: CommandStart
-start = starting "commit" (ActionItemOther (Just "git-annex")) $ do
+start = starting "commit" (ActionItemOther (Just "git-annex")) (SeekInput []) $ do
 		Annex.Branch.commit =<< Annex.Branch.commitMessage
 		_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
 		next $ return True

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
-seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $
+  where
-	startingCustomOutput (ActionItemOther Nothing) $ do
+	ai = ActionItemOther (Just "unset")
+	si = SeekInput [decodeBS' name]
+seek (GetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
+	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 :: () -> SeekInput -> String -> Annex Bool
-run _ p = do
+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 :: CopyOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o file key = stopUnless shouldCopy $ 
+start o si file key = stopUnless shouldCopy $ 
-	Command.Move.start (fromToOptions o) Command.Move.RemoveNever file key
+	Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
   where
 	shouldCopy
 		| autoMode o = want <||> numCopiesCheck (fromRawFilePath file) key (<)

Command/Dead.hs

@@ -32,7 +32,7 @@ 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."

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 :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o from file key = start' o from key afile ai
+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' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
-start' o from key afile ai = 
+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 []
+				Nothing -> startLocal afile ai si numcopies key []
-				Just remote -> startRemote afile ai numcopies key remote
+				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 :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
-startKeys o from (key, ai) = start' o from key (AssociatedFile Nothing) ai
+startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
 
-startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
+startLocal :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
-startLocal afile ai numcopies key preverified =
+startLocal afile ai si numcopies key preverified =
-	starting "drop" (OnlyActionOn key ai) $
+	starting "drop" (OnlyActionOn key ai) si $
 		performLocal key afile numcopies preverified
 
-startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
+startRemote :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> Key -> Remote -> CommandStart
-startRemote afile ai numcopies key remote = 
+startRemote afile ai si numcopies key remote = 
-	starting ("drop " ++ Remote.name remote) (OnlyActionOn key ai) $
+	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 :: (SeekInput, Key) -> CommandStart
-start key = starting "dropkey" (mkActionItem key) $
+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 :: Maybe Utility.Format.Format -> SeekInput -> String -> Annex Bool
-run format p = do
+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'))) $
+startUnexport' r db f ek =
-	performUnexport r db [ek] loc
+	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) 
+startMoveToTempName r db f ek = 
-	(ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc))
+	starting ("rename " ++ name r) ai si $
-	(performRename r db ek loc tmploc)
+		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 :: FindOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o file key = startingCustomOutput key $ do
+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 :: FindOptions -> (SeekInput, Key, ActionItem) -> CommandStart
-startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = 
+startKeys o (si, key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = 
-	start o (getTopFilePath topf) key
+	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 -> SeekInput -> RawFilePath -> Key -> CommandStart
-start fixwhat file key = do
+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

@@ -33,13 +33,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 "git-annex")
+	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)) $
+	go (si, (file, key)) = 
-		perform key file
+		let ai = mkActionItem (key, toRawFilePath file)
+		in starting "fromkey" ai si $
+			perform key file
 
-start :: Bool -> (String, FilePath) -> CommandStart
+start :: Bool -> (SeekInput, (String, FilePath)) -> CommandStart
-start force (keyname, file) = do
+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 :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> CommandStart
-start from inc file key = Backend.getBackend (fromRawFilePath file) key >>= \case
+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 :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart
-startKey from inc (key, ai) numcopies =
+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 :: Incremental -> SeekInput -> ActionItem -> Key -> Annex Bool -> CommandStart
-runFsck inc ai key a = stopUnless (needFsck inc key) $
+runFsck inc si ai key a = stopUnless (needFsck inc key) $
-	starting "fsck" (OnlyActionOn key ai) $ do
+	starting "fsck" (OnlyActionOn key ai) si $ do
 		ok <- a
 		when ok $
 			recordFsckTime inc key

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 :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o from file key = start' expensivecheck from key afile ai
+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 :: Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
-startKeys from (key, ai) = checkFailedTransferDirection ai Download $
+startKeys from (si, key, ai) = checkFailedTransferDirection ai Download $
-	start' (return True) from key (AssociatedFile Nothing) ai
+	start' (return True) from key (AssociatedFile Nothing) ai si
 
-start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
+start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
-start' expensivecheck from key afile ai =
+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')
+		( starting "import" ai si pickaction
-			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/InAnnex.hs

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

Command/Info.hs

@@ -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 ()
@@ -139,8 +139,8 @@ globalInfo o = do
 		evalStateT (mapM_ showStat stats) (emptyStatInfo o)
 		return True
 
-itemInfo :: InfoOptions -> String -> Annex ()
+itemInfo :: InfoOptions -> (SeekInput, String) -> Annex ()
-itemInfo o p = ifM (isdir p)
+itemInfo o (_, p) = ifM (isdir p)
 	( dirInfo o p
 	, do
 		disallowMatchingOptions

Command/Init.hs

@@ -53,10 +53,14 @@ seek = commandAction . start
 
 start :: InitOptions -> CommandStart
 start os
-	| autoEnableOnly os = starting "init" (ActionItemOther (Just "autoenable")) $
+	| autoEnableOnly os = 
-		performAutoEnableOnly
+		starting "init" (ActionItemOther (Just "autoenable")) si $
-	| otherwise = starting "init" (ActionItemOther (Just $ initDesc os)) $
+			performAutoEnableOnly
-		perform os
+	| 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)
-		ifM (isJust <$> Remote.byNameOnly name)
+		( giveup $ "There is already a remote named \"" ++ name ++ "\""
-			( giveup $ "There is already a remote named \"" ++ name ++ "\""
+		, do
-			, do
+			sameasuuid <- maybe
-				sameasuuid <- maybe
+				(pure Nothing)
-					(pure Nothing)
+				(Just . Sameas <$$> getParsed)
-					(Just . Sameas <$$> getParsed)
+				(sameas o) 
-					(sameas o) 
+			c <- newConfig name sameasuuid
-				c <- newConfig name sameasuuid
+				(Logs.Remote.keyValToConfig Proposed ws)
-					(Logs.Remote.keyValToConfig Proposed ws)
+				<$> readRemoteLog
-					<$> readRemoteLog
+			t <- either giveup return (findType c)
-				t <- either giveup return (findType c)
+			if whatElse o
-				if whatElse o
+				then startingCustomOutput (ActionItemOther Nothing) $
-					then startingCustomOutput (ActionItemOther Nothing) $
+					describeOtherParamsFor c t
-						describeOtherParamsFor c t
+				else starting "initremote" (ActionItemOther (Just name)) si $
-					else starting "initremote" (ActionItemOther (Just name)) $
+					perform t name c o
-						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.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
-start s _file k
+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 :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart
-start l file key = do
+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 :: SeekInput -> RawFilePath -> Key -> CommandStart
-start file key = ifM (isJust <$> isAnnexLink file)
+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 :: LogOptions -> (FilePath -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o outputter file key = do
+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 :: () -> SeekInput -> String -> Annex Bool
-run _ file = seekSingleGitFile file >>= \case
+run _ _ file = seekSingleGitFile file >>= \case
 	Nothing -> return False
 	Just file' -> catKeyFile file' >>= \case
 		Just k  -> do

Command/Merge.hs

@@ -29,17 +29,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 "git-annex")
+	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 $
+			, batchInput fmt parseJSONInput 
-				commandAction . startBatch
+				(commandAction . startBatch)
 			)
 		_ -> giveup "--batch is currently only supported in --json mode"
 
-start :: VectorClock -> MetaDataOptions -> RawFilePath -> Key -> CommandStart
+start :: VectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
-start c o file k = startKeys c o (k, mkActionItem (k, afile))
+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 :: VectorClock -> MetaDataOptions -> (SeekInput, Key, ActionItem) -> CommandStart
-startKeys c o (k, ai) = case getSet o of
+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 :: (SeekInput, (Either RawFilePath Key, MetaData)) -> CommandStart
-startBatch (i, (MetaData m)) = case i of
+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 :: SeekInput -> RawFilePath -> Key -> CommandStart
-start file key = do
+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 :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o file k = startKey o afile (k, ai)
+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 :: MirrorOptions -> AssociatedFile -> (SeekInput, Key, ActionItem) -> CommandStart
-startKey o afile (key, ai) = case fromToOptions o of
+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 :: FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart
-start fromto removewhen f k = start' fromto removewhen afile k ai
+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 :: FromToHereOptions -> RemoveWhen -> (SeekInput, Key, ActionItem) -> CommandStart
-startKey fromto removewhen = 
+startKey fromto removewhen (si, k, ai) = 
-	uncurry $ start' fromto removewhen (AssociatedFile Nothing)
+	start' fromto removewhen (AssociatedFile Nothing) si k ai
 
-start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
+start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> SeekInput -> Key -> ActionItem -> CommandStart
-start' fromto removewhen afile key ai =
+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 -> AssociatedFile -> Key -> ActionItem -> SeekInput -> Remote -> CommandStart
-toStart removewhen afile key ai dest = do
+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' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
-toStart' dest removewhen afile key ai = do
+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 -> AssociatedFile -> Key -> ActionItem -> SeekInput -> Remote -> CommandStart
-fromStart removewhen afile key ai src = 
+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 -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
-toHereStart removewhen afile key ai = 
+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 $
+	flip withFilesToBeCommitted l $ \(si, f) -> commandAction $
-		maybe stop (Command.Fix.start Command.Fix.FixSymlinks f)
+		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 $
+	Batch fmt -> batchInput fmt batchParser
-		batchCommandAction . start
+		(batchCommandAction . uncurry start)
-	NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
+	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 :: SeekInput -> (RawFilePath, Key) -> CommandStart
-start (file, newkey) = ifAnnexed file go stop
+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 :: (SeekInput, Key) -> CommandStart
-start key = fieldTransfer Download key $ \_p -> do
+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
+	starting "registerurl" ai si $
-		let key = keyOpt keyname
+		perform (keyOpt keyname) url
-		perform key 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) $
+	ai = ActionItemOther Nothing
-		perform u cfg mcu newname
+	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
+	Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
-		(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 :: (SeekInput, (FilePath, URLString)) -> CommandStart
-start (file, url) = flip whenAnnexed file' $ \_ key ->
+start (si, (file, url)) = flip whenAnnexed file' $ \_ key -> do
-	starting "rmurl" (mkActionItem (key, AssociatedFile (Just file'))) $
+	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 :: (SeekInput, Key) -> CommandStart
-start key = do
+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)
+		(batchCommandAction . uncurry start)
-	NoBatch -> either giveup (commandAction . 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 :: SeekInput -> KeyStatus -> CommandStart
-start (KeyStatus k u s) = starting "setpresentkey" (mkActionItem k) $
+start si (KeyStatus k u s) = starting "setpresentkey" ai si $ perform k u s
-	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 ->
+		Just syncbranch -> do
-			starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $
+			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 ->
+		Just syncbranch -> do
-			starting "merge" (ActionItemOther (Just $ Git.Ref.describe 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, _) = 
+cleanupLocal (Just currb, _) = starting "cleanup" ai si $ next $ do
-	starting "cleanup" (ActionItemOther (Just "local")) $ 
+	delbranch $ syncBranch currb
-		next $ do
+	delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
-			delbranch $ syncBranch currb
+	mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r) =<< listTaggedBranches
-			delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
+	return True
-			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,6 +849,9 @@ 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

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 :: TransferKeyOptions -> (SeekInput, Key) -> CommandStart
-start o key = startingCustomOutput key $ case fromToOptions o of
+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 :: SeekInput -> RawFilePath -> Key -> CommandStart
-start file key = 
+start si file key = 
-	starting "unannex" (mkActionItem (key, file)) $
+	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 :: SeekInput -> RawFilePath -> Key -> CommandStart
-start file key = ifM (isJust <$> isAnnexLink file)
+start si file key = ifM (isJust <$> isAnnexLink file)
-	( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $
+	( starting "unlock" ai si $ perform file key
-		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 :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
-start o remotemap file key = 
+start o remotemap si file key = 
-	startKeys o remotemap (key, mkActionItem (key, afile))
+	startKeys o remotemap (si, key, mkActionItem (key, afile))
   where
 	afile = AssociatedFile (Just file)
 
-startKeys :: WhereisOptions -> M.Map UUID Remote -> (Key, ActionItem) -> CommandStart
+startKeys :: WhereisOptions -> M.Map UUID Remote -> (SeekInput, Key, ActionItem) -> CommandStart
-startKeys o remotemap (key, ai)
+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
 

Messages.hs

@@ -90,19 +90,19 @@ showStartKey command key i = outputMessage json $
 	json = JSON.start command (actionItemWorkTreeFile i) (Just key)
 
 showStartMessage :: StartMessage -> Annex ()
-showStartMessage (StartMessage command ai) = case ai of
+showStartMessage (StartMessage command ai si) = 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')
+	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
-showStartMessage (StartUsualMessages command ai) = do
+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 +111,8 @@ showStartMessage (CustomOutput _) =
 
 -- Only show end result if the StartMessage is one that gets displayed.
 showEndMessage :: StartMessage -> Bool -> Annex ()
-showEndMessage (StartMessage _ _) = showEndResult
+showEndMessage (StartMessage _ _ _) = showEndResult
-showEndMessage (StartUsualMessages _ _) = showEndResult
+showEndMessage (StartUsualMessages _ _ _) = showEndResult
 showEndMessage (StartNoMessage _) = const noop
 showEndMessage (CustomOutput _) = const noop
 

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 [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
+	= StartMessage String ActionItem SeekInput
-	| StartUsualMessages String ActionItem
+	| 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 (StartMessage _ ai _) = ai
-	mkActionItem (StartUsualMessages _ ai) = ai
+	mkActionItem (StartUsualMessages _ ai _) = ai
 	mkActionItem (StartNoMessage ai) = ai
 	mkActionItem (CustomOutput ai) = ai
 

Utility/Path.hs

@@ -19,7 +19,9 @@ module Utility.Path (
 	relPathDirToFile,
 	relPathDirToFileAbs,
 	segmentPaths,
+	segmentPaths',
 	runSegmentPaths,
+	runSegmentPaths',
 	relHome,
 	inPath,
 	searchPath,
@@ -215,15 +217,19 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
  - that many paths in doesn't care too much about order of the later ones.
  -}
 segmentPaths :: (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[a]]
-segmentPaths _ [] new = [new]
+segmentPaths = segmentPaths' (\_ r -> r)
-segmentPaths _ [_] new = [new] -- optimisation
+
-segmentPaths c (l:ls) new = found : segmentPaths c ls rest
+segmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[r]]
+segmentPaths' f _ [] new = [map (f Nothing) new]
+segmentPaths' f _ [i] new = [map (f (Just i)) new] -- optimisation
+segmentPaths' f c (i:is) new = 
+	map (f (Just i)) found : segmentPaths' f c is rest
   where
-	(found, rest) = if length ls < 100
+	(found, rest) = if length is < 100
-		then partition inl new
+		then partition ini new
-		else break (not . inl) new
+		else break (not . ini) new
-	inl f = l' `dirContains` fromRawFilePath (c f)
+	ini f = i' `dirContains` fromRawFilePath (c f)
-	l' = fromRawFilePath l
+	i' = fromRawFilePath i
 
 {- This assumes that it's cheaper to call segmentPaths on the result,
  - than it would be to run the action separately with each path. In
@@ -232,6 +238,9 @@ segmentPaths c (l:ls) new = found : segmentPaths c ls rest
 runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]]
 runSegmentPaths c a paths = segmentPaths c paths <$> a paths
 
+runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]
+runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths
+
 {- Converts paths in the home directory to use ~/ -}
 relHome :: FilePath -> IO String
 relHome path = do