From 842ca9c4b684ec21b9e5a99b3742db5f36a1440f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 18 Jan 2014 14:51:55 -0400 Subject: improve matcher data type to allow matching Keys, instead of just files (no behavior changes) --- Limit.hs | 58 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 30 insertions(+), 28 deletions(-) (limited to 'Limit.hs') 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 -- cgit v1.2.3