improve matcher data type to allow matching Keys, instead of just files (no behavior changes)

This commit is contained in:
Joey Hess 2014-01-18 14:51:55 -04:00
parent a135bbd5a2
commit 8ce515ffe4
8 changed files with 49 additions and 39 deletions

View file

@ -75,7 +75,7 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
) )
type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a) type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FileInfo -> Annex Bool)) type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> Annex Bool))
-- internal state storage -- internal state storage
data AnnexState = AnnexState data AnnexState = AnnexState
@ -95,7 +95,7 @@ data AnnexState = AnnexState
, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle) , checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
, forcebackend :: Maybe String , forcebackend :: Maybe String
, forcenumcopies :: Maybe Int , forcenumcopies :: Maybe Int
, limit :: Matcher (FileInfo -> Annex Bool) , limit :: Matcher (MatchInfo -> Annex Bool)
, uuidmap :: Maybe UUIDMap , uuidmap :: Maybe UUIDMap
, preferredcontentmap :: Maybe PreferredContentMap , preferredcontentmap :: Maybe PreferredContentMap
, shared :: Maybe SharedRepository , shared :: Maybe SharedRepository

View file

@ -35,11 +35,11 @@ checkFileMatcher' matcher file notpresent def
| isEmpty matcher = return def | isEmpty matcher = return def
| otherwise = do | otherwise = do
matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
let fi = FileInfo let mi = MatchingFile $ FileInfo
{ matchFile = matchfile { matchFile = matchfile
, relFile = file , relFile = file
} }
matchMrun matcher $ \a -> a notpresent fi matchMrun matcher $ \a -> a notpresent mi
matchAll :: FileMatcher matchAll :: FileMatcher
matchAll = generate [] matchAll = generate []

View file

@ -312,7 +312,7 @@ getLocalStatInfo dir = do
where where
initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats)
update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =
ifM (matcher $ FileInfo file file) ifM (matcher $ MatchingFile $ FileInfo file file)
( do ( do
!presentdata' <- ifM (inAnnex key) !presentdata' <- ifM (inAnnex key)
( return $ addKey key presentdata ( return $ addKey key presentdata

View file

@ -48,10 +48,10 @@ limited = (not . Utility.Matcher.isEmpty) <$> getMatcher'
{- Gets a matcher for the user-specified limits. The matcher is cached for {- 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. -} - 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 = Utility.Matcher.matchM <$> getMatcher'
getMatcher' :: Annex (Utility.Matcher.Matcher (FileInfo -> Annex Bool)) getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool))
getMatcher' = do getMatcher' = do
m <- Annex.getState Annex.limit m <- Annex.getState Annex.limit
case m of case m of
@ -63,7 +63,7 @@ getMatcher' = do
return matcher return matcher
{- Adds something to the limit list, which is built up reversed. -} {- 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 } add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
where where
prepend (Left ls) = Left $ l:ls 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 {- 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 - once. Also, we use regex-TDFA when available, because it's less buggy
- in its support of non-unicode characters. -} - in its support of non-unicode characters. -}
matchglob :: String -> FileInfo -> Bool matchglob :: String -> MatchInfo -> Bool
matchglob glob fi = matchglob glob (MatchingFile fi) =
#ifdef WITH_TDFA #ifdef WITH_TDFA
case cregex of case cregex of
Right r -> case execute r (matchFile fi) of Right r -> case execute r (matchFile fi) of
@ -108,6 +108,7 @@ matchglob glob fi =
#else #else
wildCheckCase glob (matchFile fi) wildCheckCase glob (matchFile fi)
#endif #endif
matchglob _ (MatchingKey _) = False
{- Adds a limit to skip files not believed to be present {- Adds a limit to skip files not believed to be present
- in a specfied repository. -} - in a specfied repository. -}
@ -115,14 +116,11 @@ addIn :: String -> Annex ()
addIn = addLimit . limitIn addIn = addLimit . limitIn
limitIn :: MkLimit limitIn :: MkLimit
limitIn name = Right $ \notpresent -> check $ limitIn name = Right $ \notpresent -> checkKey $
if name == "." if name == "."
then inhere notpresent then inhere notpresent
else inremote notpresent else inremote notpresent
where where
check a = lookupFile >=> handle a
handle _ Nothing = return False
handle a (Just (key, _)) = a key
inremote notpresent key = do inremote notpresent key = do
u <- Remote.nameToUUID name u <- Remote.nameToUUID name
us <- Remote.keyLocations key us <- Remote.keyLocations key
@ -137,22 +135,20 @@ limitIn name = Right $ \notpresent -> check $
{- Limit to content that is currently present on a uuid. -} {- Limit to content that is currently present on a uuid. -}
limitPresent :: Maybe UUID -> MkLimit limitPresent :: Maybe UUID -> MkLimit
limitPresent u _ = Right $ const $ check $ \key -> do limitPresent u _ = Right $ const $ 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
else do else do
us <- Remote.keyLocations key us <- Remote.keyLocations key
return $ maybe False (`elem` us) u 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 -} {- Limit to content that is in a directory, anywhere in the repository tree -}
limitInDir :: FilePath -> MkLimit limitInDir :: FilePath -> MkLimit
limitInDir dir = const $ Right $ const $ \fi -> return $ limitInDir dir = const $ Right $ const go
any (== dir) $ splitPath $ takeDirectory $ matchFile fi 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 {- Adds a limit to skip files not believed to have the specified number
- of copies. -} - of copies. -}
@ -169,10 +165,9 @@ limitCopies want = case split ":" want of
where where
go num good = case readish num of go num good = case readish num of
Nothing -> Left "bad number for copies" Nothing -> Left "bad number for copies"
Just n -> Right $ \notpresent f -> Just n -> Right $ \notpresent -> checkKey $
lookupFile f >>= handle n good notpresent handle n good notpresent
handle _ _ _ Nothing = return False handle n good notpresent key = do
handle n good notpresent (Just (key, _)) = do
us <- filter (`S.notMember` notpresent) us <- filter (`S.notMember` notpresent)
<$> (filterM good =<< Remote.keyLocations key) <$> (filterM good =<< Remote.keyLocations key)
return $ length us >= n return $ length us >= n
@ -192,11 +187,10 @@ addInAllGroup groupname = do
limitInAllGroup :: GroupMap -> MkLimit limitInAllGroup :: GroupMap -> MkLimit
limitInAllGroup m groupname limitInAllGroup m groupname
| S.null want = Right $ const $ const $ return True | S.null want = Right $ const $ const $ return True
| otherwise = Right $ \notpresent -> lookupFile >=> check notpresent | otherwise = Right $ \notpresent -> checkKey $ check notpresent
where where
want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
check _ Nothing = return False check notpresent key
check notpresent (Just (key, _))
-- optimisation: Check if a wanted uuid is notpresent. -- optimisation: Check if a wanted uuid is notpresent.
| not (S.null (S.intersection want notpresent)) = return False | not (S.null (S.intersection want notpresent)) = return False
| otherwise = do | otherwise = do
@ -208,10 +202,9 @@ addInBackend :: String -> Annex ()
addInBackend = addLimit . limitInBackend addInBackend = addLimit . limitInBackend
limitInBackend :: MkLimit limitInBackend :: MkLimit
limitInBackend name = Right $ const $ lookupFile >=> check limitInBackend name = Right $ const $ checkKey check
where where
wanted = Backend.lookupBackendName name check key = pure $ keyBackendName key == name
check = return . maybe False ((==) wanted . snd)
{- Adds a limit to skip files that are too large or too small -} {- Adds a limit to skip files that are too large or too small -}
addLargerThan :: String -> Annex () addLargerThan :: String -> Annex ()
@ -225,8 +218,10 @@ limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size" Nothing -> Left "bad size"
Just sz -> Right $ go sz Just sz -> Right $ go sz
where where
go sz _ fi = lookupFile fi >>= check fi sz go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz
check _ sz (Just (key, _)) = return $ keySize key `vs` Just 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 check fi sz Nothing = do
filesize <- liftIO $ catchMaybeIO $ filesize <- liftIO $ catchMaybeIO $
fromIntegral . fileSize fromIntegral . fileSize
@ -249,3 +244,10 @@ addTimeLimit s = do
lookupFile :: FileInfo -> Annex (Maybe (Key, Backend)) lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
lookupFile = Backend.lookupFile . relFile 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

View file

@ -13,9 +13,11 @@ import Limit
import Types.FileMatcher import Types.FileMatcher
addWantGet :: Annex () addWantGet :: Annex ()
addWantGet = addLimit $ Right $ const $ addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False
\fileinfo -> wantGet False (Just $ matchFile fileinfo)
addWantDrop :: Annex () addWantDrop :: Annex ()
addWantDrop = addLimit $ Right $ const $ addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing
\fileinfo -> wantDrop False Nothing (Just $ matchFile fileinfo)
checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool
checkWant a (MatchingFile fi) = a (Just $ matchFile fi)
checkWant _ (MatchingKey _) = return False

View file

@ -165,7 +165,7 @@ prepFiltered a fs = do
matcher <- Limit.getMatcher matcher <- Limit.getMatcher
map (process matcher) <$> fs map (process matcher) <$> fs
where where
process matcher f = ifM (matcher $ FileInfo f f) process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
( a f , return Nothing ) ( a f , return Nothing )
notSymlink :: FilePath -> IO Bool notSymlink :: FilePath -> IO Bool

View file

@ -7,6 +7,12 @@
module Types.FileMatcher where module Types.FileMatcher where
import Types.Key (Key)
data MatchInfo
= MatchingFile FileInfo
| MatchingKey Key
data FileInfo = FileInfo data FileInfo = FileInfo
{ relFile :: FilePath -- may be relative to cwd { relFile :: FilePath -- may be relative to cwd
, matchFile :: FilePath -- filepath to match on; may be relative to top , matchFile :: FilePath -- filepath to match on; may be relative to top

View file

@ -17,4 +17,4 @@ import qualified Data.Set as S
type MkLimit = String -> Either String MatchFiles type MkLimit = String -> Either String MatchFiles
type AssumeNotPresent = S.Set UUID type AssumeNotPresent = S.Set UUID
type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool