remove whenAnnexed and ifAnnexed

In preparation for adding a new variation on lookupKey.

Sponsored-by: Max Thoursie on Patreon

Annex/WorkTree.hs

@@ -1,6 +1,6 @@
 {- git-annex worktree files
  -
- - Copyright 2013-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -45,14 +45,6 @@ lookupKey' catkeyfile file = isAnnexLink file >>= \case
 	Just key -> return (Just key)
 	Nothing -> catkeyfile file
 
-{- Modifies an action to only act on files that are already annexed,
- - and passes the key on to it. -}
-whenAnnexed :: (RawFilePath -> Key -> Annex (Maybe a)) -> RawFilePath -> Annex (Maybe a)
-whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
-
-ifAnnexed :: RawFilePath -> (Key -> Annex a) -> Annex a -> Annex a
-ifAnnexed file yes no = maybe no yes =<< lookupKey file
-
 {- Find all annexed files and update the keys database for them. -}
 scanAnnexedFiles :: Annex ()
 scanAnnexedFiles = Database.Keys.updateDatabase

CmdLine/Batch.hs

@@ -186,8 +186,9 @@ batchAnnexed fmt seeker keyaction = do
 	matcher <- getMatcher
 	batchFilesKeys fmt $ \(si, v) ->
 		case v of
-			Right bf -> flip whenAnnexed bf $ \f k ->
+			Right f -> lookupKey f >>= \case
-				checkpresent k $
+				Nothing -> return Nothing
+				Just k -> checkpresent k $
 					startAction seeker si f k
 			Left k -> ifM (matcher (MatchingInfo (mkinfo k)))
 				( checkpresent k $

Command.hs

@@ -11,7 +11,6 @@ module Command (
 ) where
 
 import Annex.Common as ReExported
-import Annex.WorkTree as ReExported (whenAnnexed, ifAnnexed)
 import Types.Command as ReExported
 import Types.DeferredParse as ReExported
 import CmdLine.Seek as ReExported

Command/Add.hs

@@ -18,6 +18,7 @@ import Annex.FileMatcher
 import Annex.Link
 import Annex.Tmp
 import Annex.HashObject
+import Annex.WorkTree
 import Messages.Progress
 import Git.FilePath
 import Git.Types
@@ -202,7 +203,9 @@ start dr si file addunlockedmatcher =
 				mk <- liftIO $ isPointerFile file
 				maybe (go s) (fixuppointer s) mk
   where
-	go s = ifAnnexed file (addpresent s) (add s)
+	go s = lookupKey file >>= \case
+		Just k -> addpresent s k
+		Nothing -> add s
 	add s = starting "add" (ActionItemTreeFile file) si $
 		skipWhenDryRun dr $
 			if isSymbolicLink s

Command/AddUrl.hs

@@ -20,6 +20,7 @@ import Annex.Ingest
 import Annex.CheckIgnore
 import Annex.Perms
 import Annex.UUID
+import Annex.WorkTree
 import Annex.YoutubeDl
 import Annex.UntrustedFilePath
 import Logs.Web
@@ -183,7 +184,9 @@ startRemote addunlockedmatcher r o si file uri sz = do
 		performRemote addunlockedmatcher r o uri (toRawFilePath file') sz
 
 performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform
-performRemote addunlockedmatcher r o uri file sz = ifAnnexed file adduri geturi
+performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case
+	Just k -> adduri k
+	Nothing -> geturi
   where
 	loguri = setDownloader uri OtherDownloader
 	adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
@@ -270,7 +273,9 @@ checkPreserveFileNameSecurity f = do
 			]
 
 performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform
-performWeb addunlockedmatcher o url file urlinfo = ifAnnexed file addurl geturl
+performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case
+	Just k -> addurl k
+	Nothing -> geturl
   where
 	geturl = next $ isJust <$> addUrlFile addunlockedmatcher (downloadOptions o) url urlinfo file
 	addurl = addUrlChecked o url file webUUID $ \k ->
@@ -335,9 +340,9 @@ downloadWeb addunlockedmatcher o url urlinfo file =
 	tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case
 		Right mediafile -> 
 			let f = youtubeDlDestFile o file (toRawFilePath mediafile)
-			in ifAnnexed f
+			in lookupKey f >>= \case
-				(alreadyannexed (fromRawFilePath f))
+				Just k -> alreadyannexed (fromRawFilePath f) k
-				(dl f)
+				Nothing -> dl f
 		Left err -> checkRaw (Just err) o Nothing (normalfinish tmp)
 	  where
 		dl dest = withTmpWorkDir mediakey $ \workdir -> do

Command/ImportFeed.hs

@@ -40,6 +40,7 @@ import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, Dow
 import Annex.UUID
 import Backend.URL (fromUrl)
 import Annex.Content
+import Annex.WorkTree
 import Annex.YoutubeDl
 import Types.MetaData
 import Logs.MetaData
@@ -297,7 +298,9 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
 	 - to be re-downloaded. -}
 	makeunique url n file = ifM alreadyexists
 		( ifM forced
-			( ifAnnexed (toRawFilePath f) checksameurl tryanother
+			( lookupKey (toRawFilePath f) >>= \case
+				Just k -> checksameurl k
+				Nothing -> tryanother
 			, tryanother
 			)
 		, return $ Just f

Command/Info.hs

@@ -28,6 +28,7 @@ import Utility.DiskFree
 import Annex.Content
 import Annex.UUID
 import Annex.CatFile
+import Annex.WorkTree
 import Logs.UUID
 import Logs.Trust
 import Logs.Location
@@ -174,9 +175,9 @@ itemInfo o (si, p) = ifM (isdir p)
 					Right u -> uuidInfo o u si
 					Left _ -> do
 						relp <- liftIO $ relPathCwdToFile (toRawFilePath p)
-						ifAnnexed relp
+						lookupKey relp >>= \case
-							(fileInfo o (fromRawFilePath relp) si)
+							Just k -> fileInfo o (fromRawFilePath relp) si k
-							(treeishInfo o p si)
+							Nothing -> treeishInfo o p si
 	)
   where
 	isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)

Command/ReKey.hs

@@ -16,6 +16,7 @@ import Annex.Perms
 import Annex.ReplaceFile
 import Logs.Location
 import Annex.InodeSentinal
+import Annex.WorkTree
 import Utility.InodeCache
 import qualified Utility.RawFilePath as R
 
@@ -61,7 +62,9 @@ seek o = case batchOption o of
 		(toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
 
 start :: SeekInput -> (RawFilePath, Key) -> CommandStart
-start si (file, newkey) = ifAnnexed file go stop
+start si (file, newkey) = lookupKey file >>= \case
+	Just k -> go k
+	Nothing -> stop
   where
 	go oldkey
 		| oldkey == newkey = stop

Command/Reinject.hs

@@ -13,6 +13,7 @@ import Annex.Content
 import Backend
 import Types.KeySource
 import Utility.Metered
+import Annex.WorkTree
 import qualified Git
 
 cmd :: Command
@@ -45,9 +46,9 @@ startSrcDest :: [FilePath] -> CommandStart
 startSrcDest ps@(src:dest:[])
 	| src == dest = stop
 	| otherwise = notAnnexed src' $
-		ifAnnexed (toRawFilePath dest) 
+		lookupKey (toRawFilePath dest) >>= \case
-			go
+			Just k -> go k
-			(giveup $ src ++ " is not an annexed file")
+			Nothing -> giveup $ src ++ " is not an annexed file"
   where
 	src' = toRawFilePath src
 	go key = starting "reinject" ai si $
@@ -79,9 +80,9 @@ notAnnexed :: RawFilePath -> CommandStart -> CommandStart
 notAnnexed src a = 
 	ifM (fromRepo Git.repoIsLocalBare)
 		( a
-		, ifAnnexed src
+		, lookupKey src >>= \case
-			(giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src)
+			Just _ -> giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src
-			a
+			Nothing -> a
 		)
 
 perform :: RawFilePath -> Key -> CommandPerform

Command/RmUrl.hs

@@ -9,6 +9,7 @@ module Command.RmUrl where
 
 import Command
 import Logs.Web
+import Annex.WorkTree
 
 cmd :: Command
 cmd = notBareRepo $
@@ -46,10 +47,12 @@ batchParser s = case separate (== ' ') (reverse s) of
 			return $ Right (f', reverse ru)
 
 start :: (SeekInput, (FilePath, URLString)) -> CommandStart
-start (si, (file, url)) = flip whenAnnexed file' $ \_ key -> do
+start (si, (file, url)) = lookupKey file' >>= \case
-	let ai = mkActionItem (key, AssociatedFile (Just file'))
+	Nothing -> stop
-	starting "rmurl" ai si $
+	Just key -> do
-		next $ cleanup url key
+		let ai = mkActionItem (key, AssociatedFile (Just file'))
+		starting "rmurl" ai si $
+			next $ cleanup url key
   where
 	file' = toRawFilePath file
 

Command/Sync.hs

@@ -50,6 +50,7 @@ import Config.DynamicConfig
 import Annex.Path
 import Annex.Wanted
 import Annex.Content
+import Annex.WorkTree
 import Command.Get (getKey')
 import qualified Command.Move
 import qualified Command.Export
@@ -765,7 +766,10 @@ seekSyncContent o rs currbranch = do
 			seekHelper fst3 ww LsFiles.inRepoDetails l
 
 	seekincludinghidden origbranch mvar l bloomfeeder =
-		seekFiltered (const (pure True)) (\(si, f) -> ifAnnexed f (commandAction . gofile bloomfeeder mvar si f) noop) $
+		let filterer = \(si, f) -> lookupKey f >>= \case
+			Just k -> (commandAction $ gofile bloomfeeder mvar si f k)
+			Nothing -> noop
+		in seekFiltered (const (pure True)) filterer $
 			seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l 
 
 	ww = WarnUnmatchLsFiles

Command/Uninit.hs

@@ -18,6 +18,7 @@ import qualified Database.Keys
 import Annex.Content
 import Annex.Init
 import Annex.CheckIgnore
+import Annex.WorkTree
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
 
@@ -50,13 +51,17 @@ seek ps = do
 	l <- workTreeItems ww ps
 	withFilesNotInGit
 		(CheckGitIgnore False)
-		WarnUnmatchWorkTreeItems 
+		WarnUnmatchWorkTreeItems
-		(\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f)
+		checksymlinks
 		l
 	withFilesInGitAnnex ww (Command.Unannex.seeker True) l
 	finish
   where
 	ww = WarnUnmatchLsFiles
+	checksymlinks (_, f) = 
+		commandAction $ lookupKey f >>= \case
+			Nothing -> stop
+			Just k -> startCheckIncomplete (fromRawFilePath f) k
 
 {- git annex symlinks that are not checked into git could be left by an
  - interrupted add. -}