move several readonly values to AnnexRead

This improves performance to a small extent in several places.

Sponsored-by: Tobias Ammann on Patreon

Command/Add.hs

@@ -89,7 +89,7 @@ seek o = startConcurrency commandStages $ do
 			s <- liftIO $ R.getSymbolicLinkStatus file
 			ifM (pure (annexdotfiles || not (dotfile file))
 				<&&> (checkFileMatcher largematcher file 
-				<||> Annex.getState Annex.force))
+				<||> Annex.getRead Annex.force))
 				( start si file addunlockedmatcher
 				, if includingsmall
 					then ifM (annexAddSmallFiles <$> Annex.getGitConfig)

Command/AddUrl.hs

@@ -191,7 +191,7 @@ downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLStri
 downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do
 	let urlkey = Backend.URL.fromUrl uri sz
 	createWorkTreeDirectory (parentDir file)
-	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
+	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
 		( do
 			addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
 			return (Just urlkey)
@@ -305,7 +305,7 @@ addUrlChecked o url file u checkexistssize key =
  -}
 addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
 addUrlFile addunlockedmatcher o url urlinfo file =
-	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
+	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
 		( nodownloadWeb addunlockedmatcher o url urlinfo file
 		, downloadWeb addunlockedmatcher o url urlinfo file
 		)

Command/Drop.hs

@@ -201,7 +201,7 @@ doDrop
 	-> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
 	-> CommandPerform
 doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) = 
-	ifM (Annex.getState Annex.force)
+	ifM (Annex.getRead Annex.force)
 		( dropaction Nothing
 		, ifM (checkRequiredContent pcc dropfrom key afile)
 			( verifyEnoughCopiesToDrop nolocmsg key 

Command/DropKey.hs

@@ -31,7 +31,7 @@ optParser desc = DropKeyOptions
 
 seek :: DropKeyOptions -> CommandSeek
 seek o = do
-	unlessM (Annex.getState Annex.force) $
+	unlessM (Annex.getRead Annex.force) $
 		giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
 	case batchOption o of
 		NoBatch -> withKeys (commandAction . start) (toDrop o)

Command/DropUnused.hs

@@ -53,7 +53,7 @@ perform from numcopies mincopies key = case from of
 	Nothing -> ifM (inAnnex key)
 		( droplocal
 		, ifM (objectFileExists key)
-			( ifM (Annex.getState Annex.force)
+			( ifM (Annex.getRead Annex.force)
 				( droplocal
 				, do
 					warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."

Command/Export.hs

@@ -96,7 +96,7 @@ seek o = startConcurrency commandStages $ do
 	db <- openDb (uuid r)
 	writeLockDbWhile db $ do
 		changeExport r db tree
-		unlessM (Annex.getState Annex.fast) $ do
+		unlessM (Annex.getRead Annex.fast) $ do
 			void $ fillExport r db tree mtbcommitsha
 	closeDb db
 

Command/Forget.hs

@@ -40,7 +40,7 @@ start o = starting "forget" ai si $ do
 	let ts = if dropDead o
 		then addTransition c ForgetDeadRemotes basets
 		else basets
-	perform ts =<< Annex.getState Annex.force
+	perform ts =<< Annex.getRead Annex.force
   where
 	ai = ActionItemOther (Just (fromRef Branch.name))
 	si = SeekInput []

Command/FromKey.hs

@@ -46,7 +46,7 @@ seek o = do
 		-- older way of enabling batch input, does not support BatchNull
 		(NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False))
 		(NoBatch, ps) -> do
-			force <- Annex.getState Annex.force
+			force <- Annex.getRead Annex.force
 			withPairs (commandAction . start matcher force) ps
 
 seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek

Command/Fsck.hs

@@ -195,7 +195,7 @@ performRemote key afile backend numcopies remote =
 	getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True)
 		( ifM (getcheap tmp)
 			( return (Just (Right UnVerified))
-			, ifM (Annex.getState Annex.fast)
+			, ifM (Annex.getRead Annex.fast)
 				( return Nothing
 				, Just <$> tryNonAsync (getfile' tmp)
 				)

Command/Import.hs

@@ -173,13 +173,13 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
 					Nothing -> importfilechecked ld k
 					Just s
 						| isDirectory s -> notoverwriting "(is a directory)"
-						| isSymbolicLink s -> ifM (Annex.getState Annex.force)
+						| isSymbolicLink s -> ifM (Annex.getRead Annex.force)
 							( do
 								liftIO $ removeWhenExistsWith R.removeLink destfile
 								importfilechecked ld k
 							, notoverwriting "(is a symlink)"
 							)
-						| otherwise -> ifM (Annex.getState Annex.force)
+						| otherwise -> ifM (Annex.getRead Annex.force)
 							( do
 								liftIO $ removeWhenExistsWith R.removeLink destfile
 								importfilechecked ld k

Command/ImportFeed.hs

@@ -135,7 +135,7 @@ data Cache = Cache
 	}
 
 getCache :: Maybe String -> Annex Cache
-getCache opttemplate = ifM (Annex.getState Annex.force)
+getCache opttemplate = ifM (Annex.getRead Annex.force)
 	( ret S.empty S.empty
 	, do
 		showStart "importfeed" "gathering known urls" (SeekInput [])
@@ -246,12 +246,12 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
 		-- to avoid adding it a second time.
 		let quviurl = setDownloader linkurl QuviDownloader
 		checkknown mediaurl $ checkknown quviurl $
-			ifM (Annex.getState Annex.fast <||> pure (relaxedOption (downloadOptions opts)))
+			ifM (Annex.getRead Annex.fast <||> pure (relaxedOption (downloadOptions opts)))
 				( addmediafast linkurl mediaurl mediakey
 				, downloadmedia linkurl mediaurl mediakey
 				)
   where
-	forced = Annex.getState Annex.force
+	forced = Annex.getRead Annex.force
 
 	{- Avoids downloading any items that are already known to be
 	 - associated with a file in the annex, unless forced. -}

Command/Info.hs

@@ -238,7 +238,7 @@ uuidInfo o u si = showCustom (unwords ["info", fromUUID u]) si $ do
 
 selStats :: [Stat] -> [Stat] -> Annex [Stat]
 selStats fast_stats slow_stats = do
-	fast <- Annex.getState Annex.fast
+	fast <- Annex.getRead Annex.fast
 	return $ if fast
 		then fast_stats
 		else fast_stats ++ slow_stats
@@ -597,7 +597,7 @@ cachedRepoData = repoData <$> get
 
 getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo
 getDirStatInfo o dir = do
-	fast <- Annex.getState Annex.fast
+	fast <- Annex.getRead Annex.fast
 	matcher <- Limit.getMatcher
 	(presentdata, referenceddata, numcopiesstats, repodata) <-
 		Command.Unused.withKeysFilesReferencedIn dir initial
@@ -625,7 +625,7 @@ getDirStatInfo o dir = do
 
 getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo)
 getTreeStatInfo o r = do
-	fast <- Annex.getState Annex.fast
+	fast <- Annex.getRead Annex.fast
 	-- git lstree filenames start with a leading "./" that prevents
 	-- matching, and also things like --include are supposed to
 	-- match relative to the current directory, which does not make

Command/Lock.hs

@@ -50,7 +50,7 @@ start si file key = ifM (isJust <$> isAnnexLink file)
 	go Nothing = 
 		ifM (isUnmodified key file)
 			( cont
-			, ifM (Annex.getState Annex.force)
+			, ifM (Annex.getRead Annex.force)
 				( cont
 				, errorModified
 				)

Command/Map.hs

@@ -52,7 +52,7 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
 
 	liftIO $ writeFile file (drawMap rs trustmap umap)
 	next $
-		ifM (Annex.getState Annex.fast)
+		ifM (Annex.getRead Annex.fast)
 			( runViewer file []
 			, runViewer file
 	 			[ ("xdot", [File file])

Command/Migrate.hs

@@ -50,7 +50,7 @@ seek o = withFilesInGitAnnex ww seeker =<< workTreeItems ww (migrateThese o)
 
 start :: MigrateOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
 start o si file key = do
-	forced <- Annex.getState Annex.force
+	forced <- Annex.getRead Annex.force
 	v <- Backend.getBackend (fromRawFilePath file) key
 	case v of
 		Nothing -> stop

Command/Move.hs

@@ -118,7 +118,7 @@ toStart removewhen afile key ai si dest = do
 
 toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
 toStart' dest removewhen afile key ai si = do
-	fast <- Annex.getState Annex.fast
+	fast <- Annex.getRead Annex.fast
 	if fast && removewhen == RemoveNever
 		then ifM (expectedPresent dest key)
 			( stop
@@ -334,7 +334,7 @@ willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy _)
 		, unlessforced DropWorse
 		)
   where
-	unlessforced r = ifM (Annex.getState Annex.force)
+	unlessforced r = ifM (Annex.getRead Annex.force)
 		( return DropAllowed
 		, return r
 		)

Command/ReKey.hs

@@ -75,7 +75,7 @@ perform file oldkey newkey = do
 	ifM (inAnnex oldkey) 
 		( unlessM (linkKey file oldkey newkey) $
 			giveup "failed creating link from old to new key"
-		, unlessM (Annex.getState Annex.force) $
+		, unlessM (Annex.getRead Annex.force) $
 			giveup $ fromRawFilePath file ++ " is not available (use --force to override)"
 		)
 	next $ cleanup file newkey

Command/Repair.hs

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

Command/Sync.hs

@@ -324,7 +324,7 @@ syncRemotes ps = do
 
 syncRemotes' :: [String] -> [Remote] -> Annex [Remote]
 syncRemotes' ps available = 
-	ifM (Annex.getState Annex.fast) ( fastest <$> wanted , wanted )
+	ifM (Annex.getRead Annex.fast) ( fastest <$> wanted , wanted )
   where
 	wanted
 		| null ps = filterM good (concat $ Remote.byCost available)

Command/TestRemote.hs

@@ -74,7 +74,7 @@ seek = commandAction . start
 
 start :: TestRemoteOptions -> CommandStart
 start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
-	fast <- Annex.getState Annex.fast
+	fast <- Annex.getRead Annex.fast
 	cache <- liftIO newRemoteVariantCache
 	r <- either giveup (disableExportTree cache)
 		=<< Remote.byName' (testRemote o)

Command/Trust.hs

@@ -33,7 +33,7 @@ trustCommand c level = withWords (commandAction . start)
 		starting c (ActionItemOther (Just name)) si (perform name u)
 	perform name uuid = do
 		when (level >= Trusted) $
-			unlessM (Annex.getState Annex.force) $
+			unlessM (Annex.getRead Annex.force) $
 				giveup $ trustedNeedsForce name
 		trustSet uuid level
 		when (level == DeadTrusted) $

Command/Unannex.hs

@@ -26,24 +26,24 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
 		paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
+seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps
   where
 	ww = WarnUnmatchLsFiles
 
-seeker :: AnnexedFileSeeker
-seeker = AnnexedFileSeeker
-	{ startAction = start
+seeker :: Bool -> AnnexedFileSeeker
+seeker fast = AnnexedFileSeeker
+	{ startAction = start fast
 	, checkContentPresent = Just True
 	, usesLocationLog = False
 	}
 
-start :: SeekInput -> RawFilePath -> Key -> CommandStart
-start si file key = 
+start :: Bool -> SeekInput -> RawFilePath -> Key -> CommandStart
+start fast si file key = 
 	starting "unannex" (mkActionItem (key, file)) si $
-		perform file key
+		perform fast file key
 
-perform :: RawFilePath -> Key -> CommandPerform
-perform file key = do
+perform :: Bool -> RawFilePath -> Key -> CommandPerform
+perform fast file key = do
 	Annex.Queue.addCommand [] "rm"
 		[ Param "--cached"
 		, Param "--force"
@@ -58,7 +58,7 @@ perform file key = do
 		-- (cached in git).
 		Just key' -> do
 			cleanupdb
-			next $ cleanup file key'
+			next $ cleanup fast file key'
 		-- If the file is unlocked, it can be unmodified or not and
 		-- does not need to be replaced either way.
 		Nothing -> do
@@ -71,11 +71,11 @@ perform file key = do
 		maybe noop Database.Keys.removeInodeCache
 			=<< withTSDelta (liftIO . genInodeCache file)
 
-cleanup :: RawFilePath -> Key -> CommandCleanup
-cleanup file key = do
+cleanup :: Bool -> RawFilePath -> Key -> CommandCleanup
+cleanup fast file key = do
 	liftIO $ removeFile (fromRawFilePath file)
 	src <- calcRepo (gitAnnexLocation key)
-	ifM (Annex.getState Annex.fast)
+	ifM (pure fast <||> Annex.getRead Annex.fast)
 		( do
 			-- Only make a hard link if the annexed file does not
 			-- already have other hard links pointing at it. This

Command/Uninit.hs

@@ -8,7 +8,6 @@
 module Command.Uninit where
 
 import Command
-import qualified Annex
 import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
@@ -54,8 +53,7 @@ seek ps = do
 		WarnUnmatchWorkTreeItems 
 		(\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f)
 		l
-	Annex.changeState $ \s -> s { Annex.fast = True }
-	withFilesInGitAnnex ww Command.Unannex.seeker l
+	withFilesInGitAnnex ww (Command.Unannex.seeker True) l
 	finish
   where
 	ww = WarnUnmatchLsFiles

Command/Unused.hs

@@ -77,7 +77,7 @@ start o = do
 
 checkUnused :: RefSpec -> CommandPerform
 checkUnused refspec = chain 0
-	[ check "" unusedMsg $ findunused =<< Annex.getState Annex.fast
+	[ check "" unusedMsg $ findunused =<< Annex.getRead Annex.fast
 	, check "bad" staleBadMsg $ staleKeysPrune gitAnnexBadDir False
 	, check "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpObjectDir True
 	]