This commit is contained in:
Joey Hess 2016-02-03 13:23:34 -04:00
parent 5d9c7a1164
commit cdf5977053
Failed to extract signature
3 changed files with 19 additions and 22 deletions

View file

@ -71,33 +71,33 @@ exprParser matchstandard matchgroupwanted getgroupmap configmap mu expr =
preferreddir = fromMaybe "public" $ preferreddir = fromMaybe "public" $
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex)) parseToken :: FileMatcher Annex -> FileMatcher Annex -> MatchFiles Annex -> MatchFiles Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex))
parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t
| t `elem` tokens = Right $ token t | t `elem` tokens = Right $ token t
| otherwise = case t of | otherwise = case t of
"standard" -> call matchstandard "standard" -> call matchstandard
"groupwanted" -> call matchgroupwanted "groupwanted" -> call matchgroupwanted
"present" -> use checkpresent "present" -> simply checkpresent
"inpreferreddir" -> use checkpreferreddir "inpreferreddir" -> simply checkpreferreddir
"unused" -> simply limitUnused "unused" -> simply limitUnused
"anything" -> simply limitAnything "anything" -> simply limitAnything
"nothing" -> simply limitNothing "nothing" -> simply limitNothing
_ -> case k of _ -> case k of
"include" -> use limitInclude "include" -> usev limitInclude
"exclude" -> use limitExclude "exclude" -> usev limitExclude
"copies" -> use limitCopies "copies" -> usev limitCopies
"lackingcopies" -> use $ limitLackingCopies False "lackingcopies" -> usev $ limitLackingCopies False
"approxlackingcopies" -> use $ limitLackingCopies True "approxlackingcopies" -> usev $ limitLackingCopies True
"inbackend" -> use limitInBackend "inbackend" -> usev limitInBackend
"largerthan" -> use $ limitSize (>) "largerthan" -> usev $ limitSize (>)
"smallerthan" -> use $ limitSize (<) "smallerthan" -> usev $ limitSize (<)
"metadata" -> use limitMetaData "metadata" -> usev limitMetaData
"inallgroup" -> use $ limitInAllGroup getgroupmap "inallgroup" -> usev $ limitInAllGroup getgroupmap
_ -> Left $ "near " ++ show t _ -> Left $ "near " ++ show t
where where
(k, v) = separate (== '=') t (k, v) = separate (== '=') t
simply = Right . Operation simply = Right . Operation
use a = Operation <$> a v usev a = Operation <$> a v
call sub = Right $ Operation $ \notpresent mi -> call sub = Right $ Operation $ \notpresent mi ->
matchMrun sub $ \a -> a notpresent mi matchMrun sub $ \a -> a notpresent mi

View file

@ -118,11 +118,8 @@ addIn s = addLimit =<< mk
else inAnnex key else inAnnex key
{- Limit to content that is currently present on a uuid. -} {- Limit to content that is currently present on a uuid. -}
limitPresent :: Maybe UUID -> MkLimit Annex limitPresent :: Maybe UUID -> MatchFiles Annex
limitPresent u _ = Right $ matchPresent u limitPresent u _ = checkKey $ \key -> do
matchPresent :: Maybe UUID -> MatchFiles Annex
matchPresent u _ = checkKey $ \key -> do
hereu <- getUUID hereu <- getUUID
if u == Just hereu || isNothing u if u == Just hereu || isNothing u
then inAnnex key then inAnnex key
@ -131,8 +128,8 @@ matchPresent u _ = checkKey $ \key -> do
return $ maybe False (`elem` us) u return $ maybe False (`elem` us) u
{- Limit to content that is in a directory, anywhere in the repository tree -} {- Limit to content that is in a directory, anywhere in the repository tree -}
limitInDir :: FilePath -> MkLimit Annex limitInDir :: FilePath -> MatchFiles Annex
limitInDir dir = const $ Right $ const go limitInDir dir = const go
where where
go (MatchingFile fi) = checkf $ matchFile fi go (MatchingFile fi) = checkf $ matchFile fi
go (MatchingKey _) = return False go (MatchingKey _) = return False

View file

@ -125,7 +125,7 @@ makeMatcher groupmap configmap groupwantedmap u = go True True
unknownMatcher :: UUID -> FileMatcher Annex unknownMatcher :: UUID -> FileMatcher Annex
unknownMatcher u = generate [present] unknownMatcher u = generate [present]
where where
present = Operation $ matchPresent (Just u) present = Operation $ limitPresent (Just u)
{- Checks if an expression can be parsed, if not returns Just error -} {- Checks if an expression can be parsed, if not returns Just error -}
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String checkPreferredContentExpression :: PreferredContentExpression -> Maybe String