improve matcher data type to allow matching Keys, instead of just files (no behavior changes)
This commit is contained in:
parent
a135bbd5a2
commit
8ce515ffe4
8 changed files with 49 additions and 39 deletions
4
Annex.hs
4
Annex.hs
|
@ -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
|
||||||
|
|
|
@ -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 []
|
||||||
|
|
|
@ -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
|
||||||
|
|
58
Limit.hs
58
Limit.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
2
Seek.hs
2
Seek.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue