convert all applicable commands to new 2x faster annexed file seeking

This removes all calls to inAnnex, except for some involving --batch.
It may be that the batch code could get a similar speedup, but I don't
know if people habitually pass a huge number of files through --batch
that git-annex does not need to do anything to process, so I skipped it
for now.

A few calls to ifAnnexed remain, and might be worth doing more to
convert. In particular, Command.Sync has one that would probably speed
it up by a good amount.

(also removed some dead code from Command.Lock)

CmdLine/Action.hs

@@ -43,6 +43,9 @@ performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do
 commandActions :: [CommandStart] -> Annex ()
 commandActions = mapM_ commandAction
 
+commandAction' :: (a -> b -> CommandStart) -> a -> b -> Annex ()
+commandAction' start a b = commandAction $ start a b
+
 {- Runs one of the actions needed to perform a command.
  - Individual actions can fail without stopping the whole command,
  - including by throwing non-async exceptions.

CmdLine/Seek.hs

@@ -53,18 +53,18 @@ withFilesInGitAnnex :: WarnUnmatchWhen -> (RawFilePath -> Key -> CommandSeek) ->
 withFilesInGitAnnex ww a l = seekFilteredKeys a $
 	seekHelper fst3 ww LsFiles.inRepoDetails l
 
-withFilesInGitNonRecursive :: WarnUnmatchWhen -> String -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
+withFilesInGitAnnexNonRecursive :: WarnUnmatchWhen -> String -> (RawFilePath -> Key -> CommandSeek) -> [WorkTreeItem] -> CommandSeek
-withFilesInGitNonRecursive ww needforce a l = ifM (Annex.getState Annex.force)
+withFilesInGitAnnexNonRecursive ww needforce a l = ifM (Annex.getState Annex.force)
-	( withFilesInGit ww a l
+	( withFilesInGitAnnex ww a l
 	, if null l
 		then giveup needforce
-		else seekFiltered a (getfiles [] l)
+		else seekFilteredKeys a (getfiles [] l)
 	)
   where
 	getfiles c [] = return (reverse c)
 	getfiles c ((WorkTreeItem p):ps) = do
 		os <- seekOptions ww
-		(fs, cleanup) <- inRepo $ LsFiles.inRepo os [toRawFilePath p]
+		(fs, cleanup) <- inRepo $ LsFiles.inRepoDetails os [toRawFilePath p]
 		case fs of
 			[f] -> do
 				void $ liftIO $ cleanup

Command/Copy.hs

@@ -45,13 +45,14 @@ instance DeferredParseClass CopyOptions where
 
 seek :: CopyOptions -> CommandSeek
 seek o = startConcurrency commandStages $ do
-	let go = whenAnnexed $ start o
+	let go = start o
 	case batchOption o of
-		Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
+		Batch fmt -> batchFilesMatching fmt
+			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions
 			(keyOptions o) (autoMode o)
 			(commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
-			(withFilesInGit ww $ commandAction . go)
+			(withFilesInGitAnnex ww (commandAction' go))
 			=<< workTreeItems ww (copyFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/Drop.hs

@@ -54,13 +54,14 @@ parseDropFromOption = parseRemoteOption <$> strOption
 seek :: DropOptions -> CommandSeek
 seek o = startConcurrency commandStages $
 	case batchOption o of
-		Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
+		Batch fmt -> batchFilesMatching fmt
+			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
 			(commandAction . startKeys o)
-			(withFilesInGit ww (commandAction . go))
+			(withFilesInGitAnnex ww (commandAction' go))
 			=<< workTreeItems ww (dropFiles o)
   where
-	go = whenAnnexed $ start o
+	go = start o
 	ww = WarnUnmatchLsFiles
 
 start :: DropOptions -> RawFilePath -> Key -> CommandStart

Command/Find.hs

@@ -57,11 +57,12 @@ seek :: FindOptions -> CommandSeek
 seek o = case batchOption o of
 	NoBatch -> withKeyOptions (keyOptions o) False
 		(commandAction . startKeys o)
-		(withFilesInGit ww (commandAction . go))
+		(withFilesInGitAnnex ww (commandAction' go))
 		=<< workTreeItems ww (findThese o)
-	Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
+	Batch fmt -> batchFilesMatching fmt
+		(whenAnnexed go . toRawFilePath)
   where
-	go = whenAnnexed $ start o
+	go = start o
 	ww = WarnUnmatchLsFiles
 
 -- only files inAnnex are shown, unless the user has requested

Command/Fix.hs

@@ -31,9 +31,8 @@ cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = unlessM crippledFileSystem $ do 
+seek ps = unlessM crippledFileSystem $
-	withFilesInGit ww
+	withFilesInGitAnnex ww (commandAction' (start FixAll))
-		(commandAction . (whenAnnexed $ start FixAll))
 		=<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles

Command/Get.hs

@@ -46,7 +46,7 @@ seek o = startConcurrency downloadStages $ do
 			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
 			(commandAction . startKeys from)
-			(withFilesInGitAnnex ww (\f k -> commandAction (go f k)))
+			(withFilesInGitAnnex ww (commandAction' go))
 			=<< workTreeItems ww (getFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/Inprogress.hs

@@ -38,8 +38,8 @@ seek o = do
 			| otherwise -> commandAction stop
 		_ -> do
 			let s = S.fromList ts
-			withFilesInGit ww
+			withFilesInGitAnnex ww
-				(commandAction . (whenAnnexed (start s)))
+				(commandAction' (start s))
 				=<< workTreeItems ww (inprogressFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/List.hs

@@ -44,7 +44,7 @@ seek :: ListOptions -> CommandSeek
 seek o = do
 	list <- getList o
 	printHeader list
-	withFilesInGit ww (commandAction . (whenAnnexed $ start list))
+	withFilesInGitAnnex ww (commandAction' (start list))
 		=<< workTreeItems ww (listThese o)
   where
 	ww = WarnUnmatchLsFiles

Command/Lock.hs

@@ -8,7 +8,6 @@
 module Command.Lock where
 
 import Command
-import qualified Annex.Queue
 import qualified Annex
 import Annex.Content
 import Annex.Link
@@ -31,12 +30,12 @@ cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
 seek :: CmdParams -> CommandSeek
 seek ps = do
 	l <- workTreeItems ww ps
-	withFilesInGit ww (commandAction . (whenAnnexed startNew)) l
+	withFilesInGitAnnex ww (commandAction' start) l
   where
 	ww = WarnUnmatchLsFiles
 
-startNew :: RawFilePath -> Key -> CommandStart
+start :: RawFilePath -> Key -> CommandStart
-startNew file key = ifM (isJust <$> isAnnexLink file)
+start file key = ifM (isJust <$> isAnnexLink file)
 	( stop
 	, starting "lock" (mkActionItem (key, file)) $
 		go =<< liftIO (isPointerFile file)
@@ -53,14 +52,14 @@ startNew file key = ifM (isJust <$> isAnnexLink file)
 				, errorModified
 				)
 			)
-	cont = performNew file key
+	cont = perform file key
 
-performNew :: RawFilePath -> Key -> CommandPerform
+perform :: RawFilePath -> Key -> CommandPerform
-performNew file key = do
+perform file key = do
 	lockdown =<< calcRepo (gitAnnexLocation key)
 	addLink (fromRawFilePath file) key
 		=<< withTSDelta (liftIO . genInodeCache file)
-	next $ cleanupNew file key
+	next $ cleanup file key
   where
 	lockdown obj = do
 		ifM (isUnmodified key obj)
@@ -96,22 +95,10 @@ performNew file key = do
 
 	lostcontent = logStatus key InfoMissing
 
-cleanupNew :: RawFilePath -> Key -> CommandCleanup
+cleanup :: RawFilePath -> Key -> CommandCleanup
-cleanupNew file key = do
+cleanup file key = do
 	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
 	return True
 
-startOld :: RawFilePath -> CommandStart
-startOld file = do
-	unlessM (Annex.getState Annex.force)
-		errorModified
-	starting "lock" (ActionItemWorkTreeFile file) $
-		performOld file
-
-performOld :: RawFilePath -> CommandPerform
-performOld file = do
-	Annex.Queue.addCommand "checkout" [Param "--"] [fromRawFilePath file]
-	next $ return True
-
 errorModified :: a
 errorModified =  giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"

Command/Log.hs

@@ -86,8 +86,8 @@ seek o = do
 	zone <- liftIO getCurrentTimeZone
 	let outputter = mkOutputter m zone o
 	case (logFiles o, allOption o) of
-		(fs, False) -> withFilesInGit ww
+		(fs, False) -> withFilesInGitAnnex ww
-			(commandAction . (whenAnnexed $ start o outputter)) 
+			(commandAction' (start o outputter))
 			=<< workTreeItems ww fs
 		([], True) -> commandAction (startAll o outputter)
 		(_, True) -> giveup "Cannot specify both files and --all"

Command/MetaData.hs

@@ -77,13 +77,13 @@ seek o = case batchOption o of
 		c <- liftIO currentVectorClock
 		let ww = WarnUnmatchLsFiles
 		let seeker = case getSet o of
-			Get _ -> withFilesInGit ww
+			Get _ -> withFilesInGitAnnex ww
-			GetAll -> withFilesInGit ww
+			GetAll -> withFilesInGitAnnex ww
-			Set _ -> withFilesInGitNonRecursive ww
+			Set _ -> withFilesInGitAnnexNonRecursive ww
 				"Not recursively setting metadata. Use --force to do that."
 		withKeyOptions (keyOptions o) False
 			(commandAction . startKeys c o)
-			(seeker (commandAction . (whenAnnexed (start c o))))
+			(seeker (commandAction' (start c o)))
 			=<< workTreeItems ww (forFiles o)
 	Batch fmt -> withMessageState $ \s -> case outputType s of
 		JSONOutput _ -> ifM limited

Command/Migrate.hs

@@ -26,7 +26,7 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek = withFilesInGit ww (commandAction . (whenAnnexed start))
+seek = withFilesInGitAnnex ww (commandAction' start)
 	<=< workTreeItems ww
   where
 	ww = WarnUnmatchLsFiles

Command/Mirror.hs

@@ -44,7 +44,7 @@ seek :: MirrorOptions -> CommandSeek
 seek o = startConcurrency stages $ 
 	withKeyOptions (keyOptions o) False
 		(commandAction . startKey o (AssociatedFile Nothing))
-		(withFilesInGit ww (commandAction . (whenAnnexed $ start o)))
+		(withFilesInGitAnnex ww (commandAction' (start o)))
 		=<< workTreeItems ww (mirrorFiles o)
   where
 	stages = case fromToOptions o of

Command/Move.hs

@@ -55,12 +55,13 @@ data RemoveWhen = RemoveSafe | RemoveNever
 
 seek :: MoveOptions -> CommandSeek
 seek o = startConcurrency stages $ do
-	let go = whenAnnexed $ start (fromToOptions o) (removeWhen o)
+	let go = start (fromToOptions o) (removeWhen o)
 	case batchOption o of
-		Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
+		Batch fmt -> batchFilesMatching fmt
+			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) False
 			(commandAction . startKey (fromToOptions o) (removeWhen o))
-			(withFilesInGit ww (commandAction . go))
+			(withFilesInGitAnnex ww (commandAction' go))
 			=<< workTreeItems ww (moveFiles o)
   where
 	stages = case fromToOptions o of

Command/Unannex.hs

@@ -23,7 +23,7 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = (withFilesInGit ww $ commandAction . whenAnnexed start)
+seek ps = (withFilesInGitAnnex ww (commandAction' start))
 	=<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles

Command/Uninit.hs

@@ -44,7 +44,7 @@ seek ps = do
 	l <- workTreeItems ww ps
 	withFilesNotInGit (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l
 	Annex.changeState $ \s -> s { Annex.fast = True }
-	withFilesInGit ww (commandAction . whenAnnexed Command.Unannex.start) l
+	withFilesInGitAnnex ww (commandAction' Command.Unannex.start) l
 	finish
   where
 	ww = WarnUnmatchLsFiles

Command/Unlock.hs

@@ -27,7 +27,7 @@ mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
 	command n SectionCommon d paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = withFilesInGit ww (commandAction . whenAnnexed start)
+seek ps = withFilesInGitAnnex ww (commandAction' start)
 	=<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles

Command/Whereis.hs

@@ -51,13 +51,14 @@ parseFormatOption = option (Utility.Format.gen <$> str)
 seek :: WhereisOptions -> CommandSeek
 seek o = do
 	m <- remoteMap id
-	let go = whenAnnexed $ start o m
+	let go = start o m
 	case batchOption o of
-		Batch fmt -> batchFilesMatching fmt (go . toRawFilePath)
+		Batch fmt -> batchFilesMatching fmt
+			(whenAnnexed go . toRawFilePath)
 		NoBatch -> 
 			withKeyOptions (keyOptions o) False
 				(commandAction . startKeys o m)
-				(withFilesInGit ww (commandAction . go))
+				(withFilesInGitAnnex ww (commandAction' go))
 				=<< workTreeItems ww (whereisFiles o)
   where
 	ww = WarnUnmatchLsFiles