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

This commit is contained in:
Joey Hess 2014-01-18 14:51:55 -04:00
parent a135bbd5a2
commit 8ce515ffe4
8 changed files with 49 additions and 39 deletions

View file

@ -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