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

1 files changed, 30 insertions, 28 deletions

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