3518c586cf
Several places assumed this would not happen, and when the AssociatedFile was Nothing, did nothing. As part of this, preferred content checks pass the Key around. Note that checkMatcher is sometimes now called with Just Key and Just File. It currently constructs a FileMatcher, ignoring the Key. However, if it constructed a FileKeyMatcher, which contained both, then it might be possible to speed up parts of Limit, which currently call the somewhat expensive lookupFileKey to get the Key. I have not made this optimisation yet, because I am not sure if the key is always the same. Will need some significant checking to satisfy myself that's the case..
112 lines
3.5 KiB
Haskell
112 lines
3.5 KiB
Haskell
{- git-annex file matching
|
|
-
|
|
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.FileMatcher where
|
|
|
|
import qualified Data.Map as M
|
|
|
|
import Common.Annex
|
|
import Limit
|
|
import Utility.Matcher
|
|
import Types.Group
|
|
import Types.Limit
|
|
import Logs.Group
|
|
import Logs.Remote
|
|
import Annex.UUID
|
|
import qualified Annex
|
|
import Types.FileMatcher
|
|
import Git.FilePath
|
|
import Types.Remote (RemoteConfig)
|
|
|
|
import Data.Either
|
|
import qualified Data.Set as S
|
|
|
|
type FileMatcher = Matcher MatchFiles
|
|
|
|
checkFileMatcher :: FileMatcher -> FilePath -> Annex Bool
|
|
checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True
|
|
|
|
checkMatcher :: FileMatcher -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
|
|
checkMatcher matcher mkey afile notpresent def
|
|
| isEmpty matcher = return def
|
|
| otherwise = case (mkey, afile) of
|
|
(_, Just file) -> go =<< fileMatchInfo file
|
|
(Just key, _) -> go (MatchingKey key)
|
|
_ -> return def
|
|
where
|
|
go mi = matchMrun matcher $ \a -> a notpresent mi
|
|
|
|
fileMatchInfo :: FilePath -> Annex MatchInfo
|
|
fileMatchInfo file = do
|
|
matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
|
|
return $ MatchingFile $ FileInfo
|
|
{ matchFile = matchfile
|
|
, relFile = file
|
|
}
|
|
|
|
matchAll :: FileMatcher
|
|
matchAll = generate []
|
|
|
|
parsedToMatcher :: [Either String (Token MatchFiles)] -> Either String FileMatcher
|
|
parsedToMatcher parsed = case partitionEithers parsed of
|
|
([], vs) -> Right $ generate vs
|
|
(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
|
|
|
|
exprParser :: GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
|
|
exprParser groupmap configmap mu expr =
|
|
map parse $ tokenizeMatcher expr
|
|
where
|
|
parse = parseToken
|
|
(limitPresent mu)
|
|
(limitInDir preferreddir)
|
|
groupmap
|
|
preferreddir = fromMaybe "public" $
|
|
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
|
|
|
|
parseToken :: MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
|
|
parseToken checkpresent checkpreferreddir groupmap t
|
|
| t `elem` tokens = Right $ token t
|
|
| t == "present" = use checkpresent
|
|
| t == "inpreferreddir" = use checkpreferreddir
|
|
| t == "unused" = Right (Operation limitUnused)
|
|
| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $
|
|
M.fromList
|
|
[ ("include", limitInclude)
|
|
, ("exclude", limitExclude)
|
|
, ("copies", limitCopies)
|
|
, ("lackingcopies", limitLackingCopies False)
|
|
, ("approxlackingcopies", limitLackingCopies True)
|
|
, ("inbackend", limitInBackend)
|
|
, ("largerthan", limitSize (>))
|
|
, ("smallerthan", limitSize (<))
|
|
, ("inallgroup", limitInAllGroup groupmap)
|
|
]
|
|
where
|
|
(k, v) = separate (== '=') t
|
|
use a = Operation <$> a v
|
|
|
|
{- This is really dumb tokenization; there's no support for quoted values.
|
|
- Open and close parens are always treated as standalone tokens;
|
|
- otherwise tokens must be separated by whitespace. -}
|
|
tokenizeMatcher :: String -> [String]
|
|
tokenizeMatcher = filter (not . null ) . concatMap splitparens . words
|
|
where
|
|
splitparens = segmentDelim (`elem` "()")
|
|
|
|
{- Generates a matcher for files large enough (or meeting other criteria)
|
|
- to be added to the annex, rather than directly to git. -}
|
|
largeFilesMatcher :: Annex FileMatcher
|
|
largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
|
|
where
|
|
go Nothing = return matchAll
|
|
go (Just expr) = do
|
|
gm <- groupMap
|
|
rc <- readRemoteLog
|
|
u <- getUUID
|
|
either badexpr return $
|
|
parsedToMatcher $ exprParser gm rc (Just u) expr
|
|
badexpr e = error $ "bad annex.largefiles configuration: " ++ e
|