prep for fixing find --branch --unlocked

Added LinkType to ProvidedInfo, and unified MatchingKey with
ProvidedInfo. They're both used in the same way, so there was no real
reason to keep separate.

Note that addLocked and addUnlocked still set matchNeedsFileName,
because to handle MatchingFile, they do need it. However, they
don't use it when MatchingInfo is provided. This should be ok,
the --branch case will be able skip checking matchNeedsFileName,
since it will provide a filename in any case.

Annex/FileMatcher.hs

@@ -75,7 +75,15 @@ checkMatcher matcher mkey afile notpresent notconfigured d
 		(_, AssociatedFile (Just file)) ->
 			go =<< fileMatchInfo file mkey
 		(Just key, AssociatedFile Nothing) ->
-			go (MatchingKey key afile)
+			let i = ProvidedInfo
+				{ providedFilePath = Nothing
+				, providedKey = Just key
+				, providedFileSize = Nothing
+				, providedMimeType = Nothing
+				, providedMimeEncoding = Nothing
+				, providedLinkType = Nothing
+				}
+			in go (MatchingInfo i)
 		(Nothing, _) -> d
   where
 	go mi = checkMatcher' matcher mi notpresent

Annex/Import.hs

@@ -454,11 +454,12 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
 				when (Utility.Matcher.introspect matchNeedsFileContent matcher) $
 					giveup "annex.largefiles configuration examines file contents, so cannot import without content."
  				let mi = MatchingInfo ProvidedInfo
-					{ providedFilePath = f
+					{ providedFilePath = Just f
 					, providedKey = Nothing
-					, providedFileSize = sz
+					, providedFileSize = Just sz
 					, providedMimeType = Nothing
 					, providedMimeEncoding = Nothing
+					, providedLinkType = Nothing
 					}
 				islargefile <- checkMatcher' matcher mi mempty
 				metered Nothing sz $ const $ if islargefile
@@ -703,11 +704,12 @@ matchesImportLocation :: FileMatcher Annex -> ImportLocation -> Integer -> Annex
 matchesImportLocation matcher loc sz = checkMatcher' matcher mi mempty
   where
 	mi = MatchingInfo $ ProvidedInfo
-		{ providedFilePath = fromImportLocation loc
+		{ providedFilePath = Just (fromImportLocation loc)
 		, providedKey = Nothing
-		, providedFileSize = sz
+		, providedFileSize = Just sz
 		, providedMimeType = Nothing
 		, providedMimeEncoding = Nothing
+		, providedLinkType = Nothing
 		}
 
 notIgnoredImportLocation :: ImportTreeConfig -> CheckGitIgnore -> ImportLocation -> Annex Bool

Annex/Ingest.hs

@@ -390,12 +390,12 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mt
 		-- Provide as much info as we can without access to the
 		-- file's content.
 		Nothing -> MatchingInfo $ ProvidedInfo
-			{ providedFilePath = file
+			{ providedFilePath = Just file
 			, providedKey = Just key
-			, providedFileSize = fromMaybe 0 $
+			, providedFileSize = Nothing
-				keySize `fromKey` key
 			, providedMimeType = Nothing
 			, providedMimeEncoding = Nothing
+			, providedLinkType = Nothing
 			}
 	
 	linkunlocked mode = linkFromAnnex key file mode >>= \case

CmdLine/Seek.hs

@@ -194,9 +194,24 @@ withKeyOptions ko auto seeker keyaction = withKeyOptions' ko auto mkkeyaction
 		return $ \v@(_si, k, ai) -> checkseeker k $
 			let i = case ai of
 				ActionItemBranchFilePath (BranchFilePath _ topf) _ ->
-					MatchingKey k (AssociatedFile $ Just $ getTopFilePath topf)
+					ProvidedInfo
-				_ -> MatchingKey k (AssociatedFile Nothing)
+						{ providedFilePath = Just $
-			in whenM (matcher i) $
+							getTopFilePath topf
+						, providedKey = Just k
+						, providedFileSize = Nothing
+						, providedMimeType = Nothing
+						, providedMimeEncoding = Nothing
+						, providedLinkType = Nothing
+						}
+				_ -> ProvidedInfo
+					{ providedFilePath = Nothing
+					, providedKey = Just k
+					, providedFileSize = Nothing
+					, providedMimeType = Nothing
+					, providedMimeEncoding = Nothing
+					, providedLinkType = Nothing
+					}
+			in whenM (matcher (MatchingInfo i)) $
 				keyaction v
 	checkseeker k a = case checkContentPresent seeker of
 		Nothing -> a

Command/Export.hs

@@ -491,11 +491,17 @@ filterPreferredContent r tree = logExportExcluded (uuid r) $ \logwriter -> do
 	checkmatcher matcher logwriter ti@(Git.Tree.TreeItem topf _ sha) =
 		catKey sha >>= \case
 			Just k -> do
-				-- Match filename relative to the
+				let mi = MatchingInfo $ ProvidedInfo
-				-- top of the tree.
+					{ providedFilePath = Just $
-				let af = AssociatedFile $ Just $
+						-- Match filename relative
-					getTopFilePath topf
+						-- to the top of the tree.
-				let mi = MatchingKey k af
+						getTopFilePath topf
+					, providedKey = Just k
+					, providedFileSize = Nothing
+					, providedMimeType = Nothing
+					, providedMimeEncoding = Nothing
+					, providedLinkType = Nothing
+					}
 				ifM (checkMatcher' matcher mi mempty)
 					( return (Just ti)
 					, do

Limit.hs

@@ -16,6 +16,7 @@ import Annex.WorkTree
 import Annex.UUID
 import Annex.Magic
 import Annex.Link
+import Types.Link
 import Logs.Trust
 import Annex.NumCopies
 import Types.Key
@@ -116,10 +117,10 @@ matchGlobFile glob = go
   where
 	cglob = compileGlob glob CaseSensative (GlobFilePath True) -- memoized
 	go (MatchingFile fi) = pure $ matchGlob cglob (fromRawFilePath (matchFile fi))
-	go (MatchingInfo p) = pure $ matchGlob cglob (fromRawFilePath (providedFilePath p))
+	go (MatchingInfo p) = pure $ case providedFilePath p of
+		Just f -> matchGlob cglob (fromRawFilePath f)
+		Nothing -> False
 	go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (userProvidedFilePath p)
-	go (MatchingKey _ (AssociatedFile Nothing)) = pure False
-	go (MatchingKey _ (AssociatedFile (Just af))) = pure $ matchGlob cglob (fromRawFilePath af)
 
 addMimeType :: String -> Annex ()
 addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType userProvidedMimeType
@@ -166,16 +167,19 @@ matchMagic _limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just
 		}
   where
  	cglob = compileGlob glob CaseSensative (GlobFilePath False) -- memoized
-	go (MatchingKey k _) = withObjectLoc k $ \obj -> catchBoolIO $
-		maybe False (matchGlob cglob)
-			<$> querymagic magic (fromRawFilePath obj)
 	go (MatchingFile fi) = catchBoolIO $
 		maybe False (matchGlob cglob)
 			<$> querymagic magic (fromRawFilePath (contentFile fi))
-	go (MatchingInfo p) = pure $
+	go (MatchingInfo p) = maybe
-		maybe False (matchGlob cglob) (selectprovidedinfo p)
+		(usecontent (providedKey p))
+		(pure . matchGlob cglob)
+		(selectprovidedinfo p)
 	go (MatchingUserInfo p) =
 		matchGlob cglob <$> getUserInfo (selectuserprovidedinfo p)
+	usecontent (Just k) = withObjectLoc k $ \obj -> catchBoolIO $
+		maybe False (matchGlob cglob)
+			<$> querymagic magic (fromRawFilePath obj)
+	usecontent Nothing = pure False
 matchMagic limitname _ _ _ Nothing _ = 
 	Left $ "unable to load magic database; \""++limitname++"\" cannot be used"
 
@@ -198,9 +202,6 @@ addLocked = addLimit $ Right $ MatchFiles
 	}
 
 matchLockStatus :: Bool -> MatchInfo -> Annex Bool
-matchLockStatus _ (MatchingKey _ _) = pure False
-matchLockStatus _ (MatchingInfo _) = pure False
-matchLockStatus _ (MatchingUserInfo _) = pure False
 matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do
 	let f = contentFile fi
 	islocked <- isPointerFile f >>= \case
@@ -208,6 +209,12 @@ matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do
 		Nothing -> isSymbolicLink
 			<$> getSymbolicLinkStatus (fromRawFilePath f)
 	return (islocked == wantlocked)
+matchLockStatus wantlocked (MatchingInfo p) = 
+	pure $ case providedLinkType p of
+		Nothing -> False
+		Just LockedLink -> wantlocked
+		Just UnlockedLink -> not wantlocked
+matchLockStatus _ (MatchingUserInfo _) = pure False
 
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. Optionally on a prior date. -}
@@ -269,9 +276,7 @@ limitInDir dir = MatchFiles
 	}
   where
 	go (MatchingFile fi) = checkf $ fromRawFilePath $ matchFile fi
-	go (MatchingKey _ (AssociatedFile Nothing)) = return False
+	go (MatchingInfo p) = maybe (pure False) (checkf . fromRawFilePath) (providedFilePath p)
-	go (MatchingKey _ (AssociatedFile (Just af))) = checkf $ fromRawFilePath af
-	go (MatchingInfo p) = checkf $ fromRawFilePath $ providedFilePath p
 	go (MatchingUserInfo p) = checkf =<< getUserInfo (userProvidedFilePath p)
 	checkf = return . elem dir . splitPath . takeDirectory
 
@@ -332,7 +337,6 @@ limitLackingCopies approx want = case readish want of
 			else case mi of
 				MatchingFile fi -> getGlobalFileNumCopies $
 					matchFile fi
-				MatchingKey _ _ -> approxNumCopies
 				MatchingInfo {} -> approxNumCopies
 				MatchingUserInfo {} -> approxNumCopies
 		us <- filter (`S.notMember` notpresent)
@@ -355,7 +359,6 @@ limitUnused = MatchFiles
 	}
   where
  	go _ (MatchingFile _) = return False
-	go _ (MatchingKey k _) = isunused k
 	go _ (MatchingInfo p) = maybe (pure False) isunused (providedKey p)
 	go _ (MatchingUserInfo p) = do
 		k <- getUserInfo (userProvidedKey p)
@@ -465,9 +468,9 @@ limitSize lb vs s = case readSize dataUnits s of
 		LimitDiskFiles -> do
 			filesize <- liftIO $ catchMaybeIO $ getFileSize (contentFile fi)
 			return $ filesize `vs` Just sz
-	go sz _ (MatchingKey key _) = checkkey sz key
+	go sz _ (MatchingInfo p) = case providedFileSize p of
-	go sz _ (MatchingInfo p) = return $
+		Just sz' -> pure (Just sz' `vs` Just sz)
-		Just (providedFileSize p) `vs` Just sz
+		Nothing -> maybe (pure False) (checkkey sz) (providedKey p)
 	go sz _ (MatchingUserInfo p) =
 		getUserInfo (userProvidedFileSize p) 
 			>>= \sz' -> return (Just sz' `vs` Just sz)
@@ -517,6 +520,5 @@ lookupFileKey fi = case matchKey fi of
 
 checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
 checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
-checkKey a (MatchingKey k _) = a k
 checkKey a (MatchingInfo p) = maybe (return False) a (providedKey p)
 checkKey a (MatchingUserInfo p) = a =<< getUserInfo (userProvidedKey p)

Limit/Wanted.hs

@@ -37,6 +37,5 @@ addPreferredContentLimit a = do
 
 checkWant :: (AssociatedFile -> Annex Bool) -> MatchInfo -> Annex Bool
 checkWant a (MatchingFile fi) = a (AssociatedFile (Just $ matchFile fi))
-checkWant a (MatchingKey _ af) = a af
+checkWant a (MatchingInfo p) = a (AssociatedFile (providedFilePath p))
-checkWant a (MatchingInfo p) = a (AssociatedFile (Just $ providedFilePath p))
 checkWant _ (MatchingUserInfo {}) = return False

Types/FileMatcher.hs

@@ -1,6 +1,6 @@
 {- git-annex file matcher types
  -
- - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -8,7 +8,8 @@
 module Types.FileMatcher where
 
 import Types.UUID (UUID)
-import Types.Key (Key, AssociatedFile)
+import Types.Key (Key)
+import Types.Link (LinkType)
 import Types.Mime
 import Utility.Matcher (Matcher, Token)
 import Utility.FileSize
@@ -21,10 +22,6 @@ import qualified Data.Set as S
 -- Information about a file and/or a key that can be matched on.
 data MatchInfo
 	= MatchingFile FileInfo
-	| MatchingKey Key AssociatedFile
-	-- ^ This is used when matching a file that may be in another
-	-- branch. The AssociatedFile is the filename, but it should not be
-	-- accessed from disk when matching.
 	| MatchingInfo ProvidedInfo
 	| MatchingUserInfo UserProvidedInfo
 
@@ -41,11 +38,13 @@ data FileInfo = FileInfo
 	}
 
 data ProvidedInfo = ProvidedInfo
-	{ providedFilePath :: RawFilePath
+	{ providedFilePath :: Maybe RawFilePath
+	-- ^ filepath to match on, should not be accessed from disk.
 	, providedKey :: Maybe Key
-	, providedFileSize :: FileSize
+	, providedFileSize :: Maybe FileSize
 	, providedMimeType :: Maybe MimeType
 	, providedMimeEncoding :: Maybe MimeEncoding
+	, providedLinkType :: Maybe LinkType
 	}
 
 -- This is used when testing a matcher, with values to match against

Types/Link.hs

@@ -0,0 +1,13 @@
+{- Types for links to content
+ -
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Types.Link where
+
+-- A locked link is stored in git as a symlink, while an unlocked link is
+-- stored as a pointer file.
+data LinkType = LockedLink | UnlockedLink
+	deriving (Show, Eq)

git-annex.cabal

@@ -1019,6 +1019,7 @@ Executable git-annex
     Types.IndexFiles
     Types.Key
     Types.KeySource
+    Types.Link
     Types.LockCache
     Types.Messages
     Types.MetaData