From 11c3a7cd331f7b07e62493a4e8e37e0cecffc5b0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 3 Feb 2016 14:56:34 -0400 Subject: Limit annex.largefiles parsing to the subset of preferred content expressions that make sense in its context. So, not "standard" or "lackingcopies", etc. --- Annex/FileMatcher.hs | 119 +++++++++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 51 deletions(-) (limited to 'Annex') diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index e3482ec8b..b4a4b6d9a 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -5,7 +5,15 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.FileMatcher where +module Annex.FileMatcher ( + GetFileMatcher, + checkFileMatcher, + checkMatcher, + matchAll, + preferredContentParser, + parsedToMatcher, + largeFilesMatcher, +) where import qualified Data.Map as M @@ -13,8 +21,6 @@ import Annex.Common import Limit import Utility.Matcher import Types.Group -import Logs.Group -import Annex.UUID import qualified Annex import Types.FileMatcher import Git.FilePath @@ -53,53 +59,38 @@ fileMatchInfo file = do matchAll :: FileMatcher Annex matchAll = generate [] -parsedToMatcher :: [Either String (Token (MatchFiles Annex))] -> Either String (FileMatcher Annex) +parsedToMatcher :: [ParseResult] -> Either String (FileMatcher Annex) parsedToMatcher parsed = case partitionEithers parsed of ([], vs) -> Right $ generate vs (es, _) -> Left $ unwords $ map ("Parse failure: " ++) es -exprParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))] -exprParser matchstandard matchgroupwanted getgroupmap configmap mu expr = - map parse $ tokenizeMatcher expr - where - parse = parseToken - matchstandard - matchgroupwanted - (limitPresent mu) - (limitInDir preferreddir) - getgroupmap - preferreddir = fromMaybe "public" $ - M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu +data ParseToken + = SimpleToken String ParseResult + | ValueToken String (String -> ParseResult) -parseToken :: FileMatcher Annex -> FileMatcher Annex -> MatchFiles Annex -> MatchFiles Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex)) -parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t +type ParseResult = Either String (Token (MatchFiles Annex)) + +parseToken :: [ParseToken] -> String -> ParseResult +parseToken l t | t `elem` tokens = Right $ token t - | otherwise = case t of - "standard" -> call matchstandard - "groupwanted" -> call matchgroupwanted - "present" -> simply checkpresent - "inpreferreddir" -> simply checkpreferreddir - "unused" -> simply limitUnused - "anything" -> simply limitAnything - "nothing" -> simply limitNothing - _ -> case k of - "include" -> usev limitInclude - "exclude" -> usev limitExclude - "copies" -> usev limitCopies - "lackingcopies" -> usev $ limitLackingCopies False - "approxlackingcopies" -> usev $ limitLackingCopies True - "inbackend" -> usev limitInBackend - "largerthan" -> usev $ limitSize (>) - "smallerthan" -> usev $ limitSize (<) - "metadata" -> usev limitMetaData - "inallgroup" -> usev $ limitInAllGroup getgroupmap - _ -> Left $ "near " ++ show t + | otherwise = go l where + go [] = Left $ "near " ++ show t + go (SimpleToken s r : _) | s == t = r + go (ValueToken s mkr : _) | s == k = mkr v + go (_ : ps) = go ps (k, v) = separate (== '=') t - simply = Right . Operation - usev a = Operation <$> a v - call sub = Right $ Operation $ \notpresent mi -> - matchMrun sub $ \a -> a notpresent mi + +commonTokens :: [ParseToken] +commonTokens = + [ SimpleToken "unused" (simply limitUnused) + , SimpleToken "anything" (simply limitAnything) + , SimpleToken "nothing" (simply limitNothing) + , ValueToken "include" (usev limitInclude) + , ValueToken "exclude" (usev limitExclude) + , ValueToken "largerthan" (usev $ limitSize (>)) + , ValueToken "smallerthan" (usev $ limitSize (<)) + ] {- This is really dumb tokenization; there's no support for quoted values. - Open and close parens are always treated as standalone tokens; @@ -109,6 +100,30 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words where splitparens = segmentDelim (`elem` "()") +preferredContentParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [ParseResult] +preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu expr = + map parse $ tokenizeMatcher expr + where + parse = parseToken $ + [ SimpleToken "standard" (call matchstandard) + , SimpleToken "groupwanted" (call matchgroupwanted) + , SimpleToken "present" (simply $ limitPresent mu) + , SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir) + , ValueToken "copies" (usev limitCopies) + , ValueToken "lackingcopies" (usev $ limitLackingCopies False) + , ValueToken "approxlackingcopies" (usev $ limitLackingCopies True) + , ValueToken "inbacked" (usev limitInBackend) + , ValueToken "metadata" (usev limitMetaData) + , ValueToken "inallgroup" (usev $ limitInAllGroup getgroupmap) + ] ++ commonTokens + preferreddir = fromMaybe "public" $ + M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu + +largeFilesParser :: String -> [ParseResult] +largeFilesParser expr = map parse $ tokenizeMatcher expr + where + parse = parseToken commonTokens + {- Generates a matcher for files large enough (or meeting other criteria) - to be added to the annex, rather than directly to git. -} largeFilesMatcher :: Annex GetFileMatcher @@ -123,13 +138,15 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig then return matchAll else mkmatcher expr - mkmatcher expr = do - u <- getUUID - -- No need to read remote configs, that's only needed for - -- inpreferreddir, which is used in preferred content - -- expressions but does not make sense in the - -- annex.largefiles expression. - let emptyconfig = M.empty - either badexpr return $ - parsedToMatcher $ exprParser matchAll matchAll groupMap emptyconfig (Just u) expr + mkmatcher = either badexpr return . parsedToMatcher . largeFilesParser badexpr e = error $ "bad annex.largefiles configuration: " ++ e + +simply :: MatchFiles Annex -> ParseResult +simply = Right . Operation + +usev :: MkLimit Annex -> String -> ParseResult +usev a v = Operation <$> a v + +call :: FileMatcher Annex -> ParseResult +call sub = Right $ Operation $ \notpresent mi -> + matchMrun sub $ \a -> a notpresent mi -- cgit v1.2.3