mostly done with location log precaching

Some nice wins.

Command/Copy.hs

@@ -46,13 +46,18 @@ instance DeferredParseClass CopyOptions where
 seek :: CopyOptions -> CommandSeek
 seek o = startConcurrency commandStages $ do
 	let go = start o
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' go
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 	case batchOption o of
 		Batch fmt -> batchFilesMatching fmt
 			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions
 			(keyOptions o) (autoMode o)
 			(commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
-			(withFilesInGitAnnex ww (commandAction' go))
+			(withFilesInGitAnnex ww seeker)
 			=<< workTreeItems ww (copyFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/Drop.hs

@@ -58,12 +58,18 @@ seek o = startConcurrency commandStages $
 			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
 			(commandAction . startKeys o)
-			(withFilesInGitAnnex ww (commandAction' go))
+			(withFilesInGitAnnex ww seeker)
 			=<< workTreeItems ww (dropFiles o)
   where
 	go = start o
 	ww = WarnUnmatchLsFiles
 
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' go
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
+
 start :: DropOptions -> RawFilePath -> Key -> CommandStart
 start o file key = start' o key afile ai
   where

Command/Find.hs

@@ -13,7 +13,6 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 
 import Command
-import Annex.Content
 import Limit
 import Types.Key
 import Git.FilePath
@@ -55,24 +54,31 @@ parseFormatOption =
 
 seek :: FindOptions -> CommandSeek
 seek o = case batchOption o of
-	NoBatch -> withKeyOptions (keyOptions o) False
-		(commandAction . startKeys o)
-		(withFilesInGitAnnex ww (commandAction' go))
-		=<< workTreeItems ww (findThese o)
+	NoBatch -> do
+		islimited <- limited
+		let seeker = AnnexedFileSeeker
+			{ seekAction = commandAction' go
+			-- only files with content present are shown, unless
+			-- the user has requested others via a limit
+			, checkContentPresent = if islimited
+				then Nothing
+				else Just True
+			, usesLocationLog = False
+			}
+		withKeyOptions (keyOptions o) False
+			(commandAction . startKeys o)
+			(withFilesInGitAnnex ww seeker)
+			=<< workTreeItems ww (findThese o)
 	Batch fmt -> batchFilesMatching fmt
 		(whenAnnexed go . toRawFilePath)
   where
 	go = start o
 	ww = WarnUnmatchLsFiles
 
--- only files inAnnex are shown, unless the user has requested
--- others via a limit
 start :: FindOptions -> RawFilePath -> Key -> CommandStart
-start o file key =
-	stopUnless (limited <||> inAnnex key) $
-		startingCustomOutput key $ do
-			showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key
-			next $ return True
+start o file key = startingCustomOutput key $ do
+	showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key
+	next $ return True
 
 startKeys :: FindOptions -> (Key, ActionItem) -> CommandStart
 startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = 

Command/Fix.hs

@@ -32,10 +32,14 @@ cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $
 
 seek :: CmdParams -> CommandSeek
 seek ps = unlessM crippledFileSystem $
-	withFilesInGitAnnex ww (commandAction' (start FixAll))
-		=<< workTreeItems ww ps
+	withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' (start FixAll)
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 
 data FixWhat = FixSymlinks | FixAll
 

Command/Fsck.hs

@@ -92,9 +92,14 @@ seek o = startConcurrency commandStages $ do
 	u <- maybe getUUID (pure . Remote.uuid) from
 	checkDeadRepo u
 	i <- prepIncremental u (incrementalOpt o)
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' (start from i)
+		, checkContentPresent = Just True
+		, usesLocationLog = True
+		}
 	withKeyOptions (keyOptions o) False
 		(\kai -> commandAction . startKey from i kai =<< getNumCopies)
-		(withFilesInGit ww $ commandAction . (whenAnnexed (start from i)))
+		(withFilesInGitAnnex ww seeker)
 		=<< workTreeItems ww (fsckFiles o)
 	cleanupIncremental i
 	void $ tryIO $ recordActivity Fsck u

Command/Get.hs

@@ -41,12 +41,17 @@ seek :: GetOptions -> CommandSeek
 seek o = startConcurrency downloadStages $ do
 	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
 	let go = start o from
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' go
+		, checkContentPresent = Just False
+		, usesLocationLog = True
+		}
 	case batchOption o of
 		Batch fmt -> batchFilesMatching fmt
 			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
 			(commandAction . startKeys from)
-			(withFilesInGitAnnex ww (commandAction' go))
+			(withFilesInGitAnnex ww seeker)
 			=<< workTreeItems ww (getFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/Inprogress.hs

@@ -38,8 +38,12 @@ seek o = do
 			| otherwise -> commandAction stop
 		_ -> do
 			let s = S.fromList ts
-			withFilesInGitAnnex ww
-				(commandAction' (start s))
+			let seeker = AnnexedFileSeeker
+				{ seekAction = commandAction' (start s)
+				, checkContentPresent = Nothing
+				, usesLocationLog = False
+				}
+			withFilesInGitAnnex ww seeker
 				=<< workTreeItems ww (inprogressFiles o)
   where
 	ww = WarnUnmatchLsFiles

Command/List.hs

@@ -44,8 +44,12 @@ seek :: ListOptions -> CommandSeek
 seek o = do
 	list <- getList o
 	printHeader list
-	withFilesInGitAnnex ww (commandAction' (start list))
-		=<< workTreeItems ww (listThese o)
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' (start list)
+		, checkContentPresent = Nothing
+		, usesLocationLog = True
+		}
+	withFilesInGitAnnex ww seeker =<< workTreeItems ww (listThese o)
   where
 	ww = WarnUnmatchLsFiles
 

Command/Lock.hs

@@ -28,11 +28,14 @@ cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = do
-	l <- workTreeItems ww ps
-	withFilesInGitAnnex ww (commandAction' start) l
+seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' start
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 
 start :: RawFilePath -> Key -> CommandStart
 start file key = ifM (isJust <$> isAnnexLink file)

Command/Log.hs

@@ -85,9 +85,15 @@ seek o = do
 	m <- Remote.uuidDescriptions
 	zone <- liftIO getCurrentTimeZone
 	let outputter = mkOutputter m zone o
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' (start o outputter)
+		, checkContentPresent = Nothing
+		-- the way this uses the location log would not be helped
+		-- by precaching the current value
+		, usesLocationLog = False
+		}
 	case (logFiles o, allOption o) of
-		(fs, False) -> withFilesInGitAnnex ww
-			(commandAction' (start o outputter))
+		(fs, False) -> withFilesInGitAnnex ww seeker
 			=<< workTreeItems ww fs
 		([], True) -> commandAction (startAll o outputter)
 		(_, True) -> giveup "Cannot specify both files and --all"

Command/MetaData.hs

@@ -76,14 +76,19 @@ seek o = case batchOption o of
 	NoBatch -> do
 		c <- liftIO currentVectorClock
 		let ww = WarnUnmatchLsFiles
-		let seeker = case getSet o of
+		let seeker = AnnexedFileSeeker
+			{ seekAction = commandAction' (start c o)
+			, checkContentPresent = Nothing
+			, usesLocationLog = False
+			}
+		let seekaction = case getSet o of
 			Get _ -> withFilesInGitAnnex ww
 			GetAll -> withFilesInGitAnnex ww
 			Set _ -> withFilesInGitAnnexNonRecursive ww
 				"Not recursively setting metadata. Use --force to do that."
 		withKeyOptions (keyOptions o) False
 			(commandAction . startKeys c o)
-			(seeker (commandAction' (start c o)))
+			(seekaction seeker)
 			=<< workTreeItems ww (forFiles o)
 	Batch fmt -> withMessageState $ \s -> case outputType s of
 		JSONOutput _ -> ifM limited

Command/Migrate.hs

@@ -26,10 +26,14 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek = withFilesInGitAnnex ww (commandAction' start)
-	<=< workTreeItems ww
+seek = withFilesInGitAnnex ww seeker <=< workTreeItems ww
   where
 	ww = WarnUnmatchLsFiles
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' start
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 
 start :: RawFilePath -> Key -> CommandStart
 start file key = do

Command/Mirror.hs

@@ -44,13 +44,18 @@ seek :: MirrorOptions -> CommandSeek
 seek o = startConcurrency stages $ 
 	withKeyOptions (keyOptions o) False
 		(commandAction . startKey o (AssociatedFile Nothing))
-		(withFilesInGitAnnex ww (commandAction' (start o)))
+		(withFilesInGitAnnex ww seeker)
 		=<< workTreeItems ww (mirrorFiles o)
   where
 	stages = case fromToOptions o of
 		FromRemote _ -> downloadStages
 		ToRemote _ -> commandStages
 	ww = WarnUnmatchLsFiles
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' (start o)
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 
 start :: MirrorOptions -> RawFilePath -> Key -> CommandStart
 start o file k = startKey o afile (k, ai)

Command/Move.hs

@@ -56,12 +56,17 @@ data RemoveWhen = RemoveSafe | RemoveNever
 seek :: MoveOptions -> CommandSeek
 seek o = startConcurrency stages $ do
 	let go = start (fromToOptions o) (removeWhen o)
+	let seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' go
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 	case batchOption o of
 		Batch fmt -> batchFilesMatching fmt
 			(whenAnnexed go . toRawFilePath)
 		NoBatch -> withKeyOptions (keyOptions o) False
 			(commandAction . startKey (fromToOptions o) (removeWhen o))
-			(withFilesInGitAnnex ww (commandAction' go))
+			(withFilesInGitAnnex ww seeker)
 			=<< workTreeItems ww (moveFiles o)
   where
 	stages = case fromToOptions o of

Command/Sync.hs

@@ -652,8 +652,13 @@ seekSyncContent o rs currbranch = do
 	waitForAllRunningCommandActions
 	liftIO $ not <$> isEmptyMVar mvar
   where
-	seekworktree mvar l bloomfeeder = 
-		seekFilteredKeys (gofile bloomfeeder mvar) $
+	seekworktree mvar l bloomfeeder = do
+		let seeker = AnnexedFileSeeker
+			{ seekAction = gofile bloomfeeder mvar
+			, checkContentPresent = Nothing
+			, usesLocationLog = True
+			}
+		seekFilteredKeys seeker $
 			seekHelper fst3 ww LsFiles.inRepoDetails l
 
 	seekincludinghidden origbranch mvar l bloomfeeder =

Command/Unannex.hs

@@ -23,13 +23,19 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = (withFilesInGitAnnex ww (commandAction' start))
-	=<< workTreeItems ww ps
+seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles
 
+seeker :: AnnexedFileSeeker
+seeker = AnnexedFileSeeker
+	{ seekAction = commandAction' start
+	, checkContentPresent = Nothing
+	, usesLocationLog = False
+	}
+
 start :: RawFilePath -> Key -> CommandStart
-start file key = stopUnless (inAnnex key) $
+start file key = 
 	starting "unannex" (mkActionItem (key, file)) $
 		perform file key
 

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 }
-	withFilesInGitAnnex ww (commandAction' Command.Unannex.start) l
+	withFilesInGitAnnex ww Command.Unannex.seeker l
 	finish
   where
 	ww = WarnUnmatchLsFiles

Command/Unlock.hs

@@ -27,10 +27,14 @@ mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
 	command n SectionCommon d paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = withFilesInGitAnnex ww (commandAction' start)
-	=<< workTreeItems ww ps
+seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles
+	seeker = AnnexedFileSeeker
+		{ seekAction = commandAction' start
+		, checkContentPresent = Nothing
+		, usesLocationLog = False
+		}
 
 start :: RawFilePath -> Key -> CommandStart
 start file key = ifM (isJust <$> isAnnexLink file)

Command/Whereis.hs

@@ -55,10 +55,15 @@ seek o = do
 	case batchOption o of
 		Batch fmt -> batchFilesMatching fmt
 			(whenAnnexed go . toRawFilePath)
-		NoBatch -> 
+		NoBatch -> do
+			let seeker = AnnexedFileSeeker
+				{ seekAction = commandAction' go
+				, checkContentPresent = Nothing
+				, usesLocationLog = True
+				}
 			withKeyOptions (keyOptions o) False
 				(commandAction . startKeys o m)
-				(withFilesInGitAnnex ww (commandAction' go))
+				(withFilesInGitAnnex ww seeker)
 				=<< workTreeItems ww (whereisFiles o)
   where
 	ww = WarnUnmatchLsFiles