improve matcher data type to allow matching Keys, instead of just files (no behavior changes)

8 files changed, 49 insertions, 39 deletions

diff --git a/Annex.hs b/Annex.hs
index 583cb0e02..023ca88e9 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -75,7 +75,7 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
 	)
 
 type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
-type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FileInfo -> Annex Bool))
+type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> Annex Bool))
 
 -- internal state storage
 data AnnexState = AnnexState
@@ -95,7 +95,7 @@ data AnnexState = AnnexState
 	, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
 	, forcebackend :: Maybe String
 	, forcenumcopies :: Maybe Int
-	, limit :: Matcher (FileInfo -> Annex Bool)
+	, limit :: Matcher (MatchInfo -> Annex Bool)
 	, uuidmap :: Maybe UUIDMap
 	, preferredcontentmap :: Maybe PreferredContentMap
 	, shared :: Maybe SharedRepository
diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index cded857a2..96cb8fd6f 100644
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -35,11 +35,11 @@ checkFileMatcher' matcher file notpresent def
 	| isEmpty matcher = return def
 	| otherwise = do
 		matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
-		let fi = FileInfo
+		let mi = MatchingFile $ FileInfo
 			{ matchFile = matchfile
 			, relFile = file
 			}
-		matchMrun matcher $ \a -> a notpresent fi
+		matchMrun matcher $ \a -> a notpresent mi
 
 matchAll :: FileMatcher
 matchAll = generate []
diff --git a/Command/Info.hs b/Command/Info.hs
index 7a9ec15dc..b623d58e7 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -312,7 +312,7 @@ getLocalStatInfo dir = do
   where
 	initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats)
 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =
-		ifM (matcher $ FileInfo file file)
+		ifM (matcher $ MatchingFile $ FileInfo file file)
 			( do
 				!presentdata' <- ifM (inAnnex key)
 					( return $ addKey key presentdata
diff --git a/Limit.hs b/Limit.hs
index f3586e029..fa6fa1f41 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -48,10 +48,10 @@ limited = (not . Utility.Matcher.isEmpty) <$> getMatcher'
 
 {- Gets a matcher for the user-specified limits. The matcher is cached for
  - speed; once it's obtained the user-specified limits can't change. -}
-getMatcher :: Annex (FileInfo -> Annex Bool)
+getMatcher :: Annex (MatchInfo -> Annex Bool)
 getMatcher = Utility.Matcher.matchM <$> getMatcher'
 
-getMatcher' :: Annex (Utility.Matcher.Matcher (FileInfo -> Annex Bool))
+getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool))
 getMatcher' = do
 	m <- Annex.getState Annex.limit
 	case m of
@@ -63,7 +63,7 @@ getMatcher' = do
 			return matcher
 
 {- Adds something to the limit list, which is built up reversed. -}
-add :: Utility.Matcher.Token (FileInfo -> Annex Bool) -> Annex ()
+add :: Utility.Matcher.Token (MatchInfo -> Annex Bool) -> Annex ()
 add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
   where
 	prepend (Left ls) = Left $ l:ls
@@ -94,8 +94,8 @@ limitExclude glob = Right $ const $ return . not . matchglob glob
 {- Could just use wildCheckCase, but this way the regex is only compiled
  - once. Also, we use regex-TDFA when available, because it's less buggy
  - in its support of non-unicode characters. -}
-matchglob :: String -> FileInfo -> Bool
-matchglob glob fi =
+matchglob :: String -> MatchInfo -> Bool
+matchglob glob (MatchingFile fi) =
 #ifdef WITH_TDFA
 	case cregex of
 		Right r -> case execute r (matchFile fi) of
@@ -108,6 +108,7 @@ matchglob glob fi =
 #else
 	wildCheckCase glob (matchFile fi)
 #endif
+matchglob _ (MatchingKey _) = False
 
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. -}
@@ -115,14 +116,11 @@ addIn :: String -> Annex ()
 addIn = addLimit . limitIn
 
 limitIn :: MkLimit
-limitIn name = Right $ \notpresent -> check $
+limitIn name = Right $ \notpresent -> checkKey $
 	if name == "."
 		then inhere notpresent
 		else inremote notpresent
   where
-	check a = lookupFile >=> handle a
-	handle _ Nothing = return False
-	handle a (Just (key, _)) = a key
 	inremote notpresent key = do
 		u <- Remote.nameToUUID name
 		us <- Remote.keyLocations key
@@ -137,22 +135,20 @@ limitIn name = Right $ \notpresent -> check $
 
 {- Limit to content that is currently present on a uuid. -}
 limitPresent :: Maybe UUID -> MkLimit
-limitPresent u _ = Right $ const $ check $ \key -> do
+limitPresent u _ = Right $ const $ checkKey $ \key -> do
 	hereu <- getUUID
 	if u == Just hereu || isNothing u
 		then inAnnex key
 		else do
 			us <- Remote.keyLocations key
 			return $ maybe False (`elem` us) u
-  where
-	check a = lookupFile >=> handle a
-	handle _ Nothing = return False
-	handle a (Just (key, _)) = a key
 
 {- Limit to content that is in a directory, anywhere in the repository tree -}
 limitInDir :: FilePath -> MkLimit
-limitInDir dir = const $ Right $ const $ \fi -> return $
-	any (== dir) $ splitPath $ takeDirectory $ matchFile fi
+limitInDir dir = const $ Right $ const go
+  where
+	go (MatchingFile fi) = return $ any (== dir) $ splitPath $ takeDirectory $ matchFile fi
+	go (MatchingKey _) = return False
 
 {- Adds a limit to skip files not believed to have the specified number
  - of copies. -}
@@ -169,10 +165,9 @@ limitCopies want = case split ":" want of
   where
 	go num good = case readish num of
 		Nothing -> Left "bad number for copies"
-		Just n -> Right $ \notpresent f ->
-			lookupFile f >>= handle n good notpresent
-	handle _ _ _ Nothing = return False
-	handle n good notpresent (Just (key, _)) = do
+		Just n -> Right $ \notpresent -> checkKey $
+			handle n good notpresent
+	handle n good notpresent key = do
 		us <- filter (`S.notMember` notpresent)
 			<$> (filterM good =<< Remote.keyLocations key)
 		return $ length us >= n
@@ -192,11 +187,10 @@ addInAllGroup groupname = do
 limitInAllGroup :: GroupMap -> MkLimit
 limitInAllGroup m groupname
 	| S.null want = Right $ const $ const $ return True
-	| otherwise = Right $ \notpresent -> lookupFile >=> check notpresent
+	| otherwise = Right $ \notpresent -> checkKey $ check notpresent
   where
 	want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
-	check _ Nothing = return False
-	check notpresent (Just (key, _))
+	check notpresent key
 		-- optimisation: Check if a wanted uuid is notpresent.
 		| not (S.null (S.intersection want notpresent))	= return False
 		| otherwise = do
@@ -208,10 +202,9 @@ addInBackend :: String -> Annex ()
 addInBackend = addLimit . limitInBackend
 
 limitInBackend :: MkLimit
-limitInBackend name = Right $ const $ lookupFile >=> check
+limitInBackend name = Right $ const $ checkKey check
   where
-	wanted = Backend.lookupBackendName name
-	check = return . maybe False ((==) wanted . snd)
+	check key = pure $ keyBackendName key == name
 
 {- Adds a limit to skip files that are too large or too small -}
 addLargerThan :: String -> Annex ()
@@ -225,8 +218,10 @@ limitSize vs s = case readSize dataUnits s of
 	Nothing -> Left "bad size"
 	Just sz -> Right $ go sz
   where
-  	go sz _ fi = lookupFile fi >>= check fi sz
-	check _ sz (Just (key, _)) = return $ keySize key `vs` Just sz
+  	go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz
+	go sz _ (MatchingKey key) = checkkey sz key
+	checkkey sz key = return $ keySize key `vs` Just sz
+	check _ sz (Just (key, _)) = checkkey sz key
 	check fi sz Nothing = do
 		filesize <- liftIO $ catchMaybeIO $
 			fromIntegral . fileSize
@@ -249,3 +244,10 @@ addTimeLimit s = do
 
 lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
 lookupFile = Backend.lookupFile . relFile
+
+lookupFileKey :: FileInfo -> Annex (Maybe Key)
+lookupFileKey = (fst <$>) <$$> Backend.lookupFile . relFile
+
+checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
+checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
+checkKey a (MatchingKey k) = a k
diff --git a/Limit/Wanted.hs b/Limit/Wanted.hs
index ed4529dea..7e9278202 100644
--- a/Limit/Wanted.hs
+++ b/Limit/Wanted.hs
@@ -13,9 +13,11 @@ import Limit
 import Types.FileMatcher
 
 addWantGet :: Annex ()
-addWantGet = addLimit $ Right $ const $
-	\fileinfo -> wantGet False (Just $ matchFile fileinfo)
+addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False
 
 addWantDrop :: Annex ()
-addWantDrop = addLimit $ Right $ const $
-	\fileinfo -> wantDrop False Nothing (Just $ matchFile fileinfo)
+addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing
+
+checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool
+checkWant a (MatchingFile fi) = a (Just $ matchFile fi)
+checkWant _ (MatchingKey _) = return False
diff --git a/Seek.hs b/Seek.hs
index a4e9a2fe5..4b3281a56 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -165,7 +165,7 @@ prepFiltered a fs = do
 	matcher <- Limit.getMatcher
 	map (process matcher) <$> fs
   where
-	process matcher f = ifM (matcher $ FileInfo f f)
+	process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
 		( a f , return Nothing )
 
 notSymlink :: FilePath -> IO Bool
diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs
index fc442b604..e2d4eadc1 100644
--- a/Types/FileMatcher.hs
+++ b/Types/FileMatcher.hs
@@ -7,6 +7,12 @@
 
 module Types.FileMatcher where
 
+import Types.Key (Key)
+
+data MatchInfo
+	= MatchingFile FileInfo
+	| MatchingKey Key
+
 data FileInfo = FileInfo
 	{ relFile :: FilePath -- may be relative to cwd
 	, matchFile :: FilePath -- filepath to match on; may be relative to top
diff --git a/Types/Limit.hs b/Types/Limit.hs
index 4436f6953..2b009a758 100644
--- a/Types/Limit.hs
+++ b/Types/Limit.hs
@@ -17,4 +17,4 @@ import qualified Data.Set as S
 type MkLimit = String -> Either String MatchFiles
 
 type AssumeNotPresent = S.Set UUID
-type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool
+type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool