improve matcher data type to allow matching Keys, instead of just files (no behavior changes)
This commit is contained in:
parent
a135bbd5a2
commit
8ce515ffe4
8 changed files with 49 additions and 39 deletions
58
Limit.hs
58
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue