mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

factor out MatchFiles Annex

Browse source 
This makes parseToken more general
This commit is contained in:
Joey Hess 2019-05-14 12:44:50 -04:00
parent a3e24ed533
commit 5cc0ee70c0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 12 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Annex/FileMatcher.hs
View file

@ -72,18 +72,18 @@ fileMatchInfo file = do
matchAll :: FileMatcher Annex matchAll :: FileMatcher Annex
matchAll = generate [] matchAll = generate []
parsedToMatcher :: [ParseResult] -> Either String (FileMatcher Annex) parsedToMatcher :: [ParseResult (MatchFiles Annex)] -> Either String (FileMatcher Annex)
parsedToMatcher parsed = case partitionEithers parsed of parsedToMatcher parsed = case partitionEithers parsed of
([], vs) -> Right $ generate vs ([], vs) -> Right $ generate vs
(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es (es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
data ParseToken data ParseToken t
= SimpleToken String ParseResult = SimpleToken String (ParseResult t)
| ValueToken String (String -> ParseResult) | ValueToken String (String -> ParseResult t)
type ParseResult = Either String (Token (MatchFiles Annex)) type ParseResult t = Either String (Token t)
parseToken :: [ParseToken] -> String -> ParseResult parseToken :: [ParseToken t] -> String -> ParseResult t
parseToken l t parseToken l t
| t `elem` tokens = Right $ token t | t `elem` tokens = Right $ token t
| otherwise = go l | otherwise = go l
@ -94,7 +94,7 @@ parseToken l t
go (_ : ps) = go ps go (_ : ps) = go ps
(k, v) = separate (== '=') t (k, v) = separate (== '=') t
commonTokens :: [ParseToken] commonTokens :: [ParseToken (MatchFiles Annex)]
commonTokens = commonTokens =
[ SimpleToken "unused" (simply limitUnused) [ SimpleToken "unused" (simply limitUnused)
, SimpleToken "anything" (simply limitAnything) , SimpleToken "anything" (simply limitAnything)
@ -113,7 +113,7 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words
where where
splitparens = segmentDelim (`elem` "()") splitparens = segmentDelim (`elem` "()")
preferredContentParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [ParseResult] preferredContentParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [ParseResult (MatchFiles Annex)]
preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu expr = preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu expr =
map parse $ tokenizeMatcher expr map parse $ tokenizeMatcher expr
where where
@ -133,7 +133,7 @@ preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu e
preferreddir = fromMaybe "public" $ preferreddir = fromMaybe "public" $
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
mkLargeFilesParser :: Annex (String -> [ParseResult]) mkLargeFilesParser :: Annex (String -> [ParseResult (MatchFiles Annex)])
mkLargeFilesParser = do mkLargeFilesParser = do
magicmime <- liftIO initMagicMime magicmime <- liftIO initMagicMime
#ifdef WITH_MAGICMIME #ifdef WITH_MAGICMIME
@ -176,12 +176,12 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
either badexpr return $ parsedToMatcher $ parser expr either badexpr return $ parsedToMatcher $ parser expr
badexpr e = giveup $ "bad annex.largefiles configuration: " ++ e badexpr e = giveup $ "bad annex.largefiles configuration: " ++ e
simply :: MatchFiles Annex -> ParseResult simply :: MatchFiles Annex -> ParseResult (MatchFiles Annex)
simply = Right . Operation simply = Right . Operation
usev :: MkLimit Annex -> String -> ParseResult usev :: MkLimit Annex -> String -> ParseResult (MatchFiles Annex)
usev a v = Operation <$> a v usev a v = Operation <$> a v
call :: FileMatcher Annex -> ParseResult call :: FileMatcher Annex -> ParseResult (MatchFiles Annex)
call sub = Right $ Operation $ \notpresent mi -> call sub = Right $ Operation $ \notpresent mi ->
matchMrun sub $ \a -> a notpresent mi matchMrun sub $ \a -> a notpresent mi