add startAction parameter for KeySha

I have a use planned for this in Command.Migrate.

Sponsored-by: unqueued on Patreon

Command/Copy.hs

@@ -63,7 +63,7 @@ seek' o fto = startConcurrency (Command.Move.stages fto) $ do
 	ww = WarnUnmatchLsFiles "copy"
 	
 	seeker = AnnexedFileSeeker
-		{ startAction = start o fto
+		{ startAction = const $ start o fto
 		, checkContentPresent = case fto of
 			FromOrToRemote (FromRemote _) -> Just False
 			FromOrToRemote (ToRemote _) -> Just True

Command/Drop.hs

@@ -60,7 +60,7 @@ seek o = startConcurrency commandStages $ do
 				then pure Nothing
 				else pure (Just remote)				
 	let seeker = AnnexedFileSeeker
-		{ startAction = start o from
+		{ startAction = const $ start o from
 		, checkContentPresent = case from of
 			Nothing -> Just True
 			Just _ -> Nothing

Command/FilterBranch.hs

@@ -157,7 +157,7 @@ seek o = withOtherTmp $ \tmpdir -> do
 					=<< Annex.Branch.get f
 			next (return True)
 		let seeker = AnnexedFileSeeker
-			{ startAction = \_ _ k -> addkeyinfo k
+			{ startAction = \_ _ _ k -> addkeyinfo k
 			, checkContentPresent = Nothing
 			, usesLocationLog = True
 			}

Command/Find.hs

@@ -63,7 +63,7 @@ seek o = do
 		checkNotBareRepo
 	isterminal <- liftIO $ checkIsTerminal stdout
 	seeker <- contentPresentUnlessLimited $ AnnexedFileSeeker
-		{ startAction = start o isterminal
+		{ startAction = const (start o isterminal)
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/FindKeys.hs

@@ -33,7 +33,7 @@ seek o = do
 		, usesLocationLog = False
 		-- startAction is not actually used since this
 		-- is not used to seek files
-		, startAction = \_ _ key -> start' o isterminal key
+		, startAction = \_ _ _ key -> start' o isterminal key
 		}
 	withKeyOptions (Just WantAllKeys) False seeker
 		(commandAction . start o isterminal)

Command/Fix.hs

@@ -37,7 +37,7 @@ seek ps = unlessM crippledFileSystem $
   where
 	ww = WarnUnmatchLsFiles "fix"
 	seeker = AnnexedFileSeeker
-		{ startAction = start FixAll
+		{ startAction = const $ start FixAll
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/Fsck.hs

@@ -102,7 +102,7 @@ seek o = startConcurrency commandStages $ do
 	checkDeadRepo u
 	i <- prepIncremental u (incrementalOpt o)
 	let seeker = AnnexedFileSeeker
-		{ startAction = start from i
+		{ startAction = const $ start from i
 		, checkContentPresent = Nothing
 		, usesLocationLog = True
 		}

Command/Get.hs

@@ -41,7 +41,7 @@ seek :: GetOptions -> CommandSeek
 seek o = startConcurrency transferStages $ do
 	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
 	let seeker = AnnexedFileSeeker
-		{ startAction = start o from
+		{ startAction = const $ start o from
 		, checkContentPresent = Just False
 		, usesLocationLog = True
 		}

Command/Inprogress.hs

@@ -42,7 +42,7 @@ seek o = do
 		_ -> do
 			let s = S.fromList ts
 			let seeker = AnnexedFileSeeker
-				{ startAction = start isterminal s
+				{ startAction = const $ start isterminal s
 				, checkContentPresent = Nothing
 				, usesLocationLog = False
 				}

Command/List.hs

@@ -50,7 +50,7 @@ seek o = do
 	list <- getList o
 	printHeader list
 	let seeker = AnnexedFileSeeker
-		{ startAction = start list
+		{ startAction = const $ start list
 		, checkContentPresent = Nothing
 		, usesLocationLog = True
 		}

Command/Lock.hs

@@ -34,7 +34,7 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles "lock"
 	seeker = AnnexedFileSeeker
-		{ startAction = start
+		{ startAction = const start
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/Log.hs

@@ -138,7 +138,7 @@ seek o = ifM (null <$> Annex.Branch.getUnmergedRefs)
 		zone <- liftIO getCurrentTimeZone
 		outputter <- mkOutputter m zone o <$> jsonOutputEnabled
 		let seeker = AnnexedFileSeeker
-			{ startAction = start o outputter
+			{ startAction = const $ start o outputter
 			, checkContentPresent = Nothing
 			-- the way this uses the location log would not be
 			-- helped by precaching the current value

Command/MetaData.hs

@@ -77,7 +77,7 @@ seek o = case batchOption o of
 		c <- currentVectorClock
 		let ww = WarnUnmatchLsFiles "metadata"
 		let seeker = AnnexedFileSeeker
-			{ startAction = start c o
+			{ startAction = const $ start c o
 			, checkContentPresent = Nothing
 			, usesLocationLog = False
 			}

Command/Migrate.hs

@@ -43,7 +43,7 @@ seek o = withFilesInGitAnnex ww seeker =<< workTreeItems ww (migrateThese o)
   where
 	ww = WarnUnmatchLsFiles "migrate"
 	seeker = AnnexedFileSeeker
-		{ startAction = start o
+		{ startAction = const $ start o
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/Mirror.hs

@@ -52,7 +52,7 @@ seek o = startConcurrency stages $
 		ToRemote _ -> commandStages
 	ww = WarnUnmatchLsFiles "mirror"
 	seeker = AnnexedFileSeeker
-		{ startAction = start o
+		{ startAction = const $ start o
 		, checkContentPresent = Nothing
 		, usesLocationLog = True
 		}

Command/Move.hs

@@ -75,7 +75,7 @@ seek' o fto = startConcurrency (stages fto) $ do
 			batchAnnexed fmt seeker keyaction
   where
 	seeker = AnnexedFileSeeker
-		{ startAction = start fto (removeWhen o)
+		{ startAction = const $ start fto (removeWhen o)
 		, checkContentPresent = case fto of
 			FromOrToRemote (FromRemote _) -> Nothing
 			FromOrToRemote (ToRemote _) -> Just True

Command/Sync.hs

@@ -842,7 +842,7 @@ seekSyncContent o rs currbranch = do
   where
 	seekworktree mvar l bloomfeeder = do
 		let seeker = AnnexedFileSeeker
-			{ startAction = gofile bloomfeeder mvar
+			{ startAction = const $ gofile bloomfeeder mvar
 			, checkContentPresent = Nothing
 			, usesLocationLog = True
 			}

Command/Unannex.hs

@@ -34,7 +34,7 @@ seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps
 
 seeker :: Bool -> AnnexedFileSeeker
 seeker fast = AnnexedFileSeeker
-	{ startAction = start fast
+	{ startAction = const $ start fast
 	, checkContentPresent = Just True
 	, usesLocationLog = False
 	}

Command/Unlock.hs

@@ -35,7 +35,7 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles "unlock"
 	seeker = AnnexedFileSeeker
-		{ startAction = start
+		{ startAction = const start
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/WhereUsed.hs

@@ -49,7 +49,7 @@ seek o = withKeyOptions (Just (keyOptions o)) False dummyfileseeker
 	(commandAction . start o) dummyfilecommandseek (WorkTreeItems [])
   where
 	dummyfileseeker = AnnexedFileSeeker
-		{ startAction = \_ _ _ -> return Nothing
+		{ startAction = \_ _ _ _ -> return Nothing
 		, checkContentPresent = Nothing
 		, usesLocationLog = False
 		}

Command/Whereis.hs

@@ -51,7 +51,7 @@ seek :: WhereisOptions -> CommandSeek
 seek o = do
 	m <- remoteMap id
 	let seeker = AnnexedFileSeeker
-		{ startAction = start o m
+		{ startAction = const $ start o m
 		, checkContentPresent = Nothing
 		, usesLocationLog = True
 		}