aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex.hs4
-rw-r--r--Annex/FileMatcher.hs4
-rw-r--r--Command/Info.hs2
-rw-r--r--Limit.hs58
-rw-r--r--Limit/Wanted.hs10
-rw-r--r--Seek.hs2
-rw-r--r--Types/FileMatcher.hs6
-rw-r--r--Types/Limit.hs2
8 files changed, 49 insertions, 39 deletions
diff --git a/Annex.hs b/Annex.hs
index 583cb0e02..023ca88e9 100644
--- a/Annex.hs
+++ b/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 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
data AnnexState = AnnexState
@@ -95,7 +95,7 @@ data AnnexState = AnnexState
, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
, forcebackend :: Maybe String
, forcenumcopies :: Maybe Int
- , limit :: Matcher (FileInfo -> Annex Bool)
+ , limit :: Matcher (MatchInfo -> Annex Bool)
, uuidmap :: Maybe UUIDMap
, preferredcontentmap :: Maybe PreferredContentMap
, shared :: Maybe SharedRepository
diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index cded857a2..96cb8fd6f 100644
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -35,11 +35,11 @@ checkFileMatcher' matcher file notpresent def
| isEmpty matcher = return def
| otherwise = do
matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
- let fi = FileInfo
+ let mi = MatchingFile $ FileInfo
{ matchFile = matchfile
, relFile = file
}
- matchMrun matcher $ \a -> a notpresent fi
+ matchMrun matcher $ \a -> a notpresent mi
matchAll :: FileMatcher
matchAll = generate []
diff --git a/Command/Info.hs b/Command/Info.hs
index 7a9ec15dc..b623d58e7 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -312,7 +312,7 @@ getLocalStatInfo dir = do
where
initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats)
update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =
- ifM (matcher $ FileInfo file file)
+ ifM (matcher $ MatchingFile $ FileInfo file file)
( do
!presentdata' <- ifM (inAnnex key)
( return $ addKey key presentdata
diff --git a/Limit.hs b/Limit.hs
index f3586e029..fa6fa1f41 100644
--- a/Limit.hs
+++ b/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
- 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' :: Annex (Utility.Matcher.Matcher (FileInfo -> Annex Bool))
+getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool))
getMatcher' = do
m <- Annex.getState Annex.limit
case m of
@@ -63,7 +63,7 @@ getMatcher' = do
return matcher
{- 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 }
where
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
- once. Also, we use regex-TDFA when available, because it's less buggy
- in its support of non-unicode characters. -}
-matchglob :: String -> FileInfo -> Bool
-matchglob glob fi =
+matchglob :: String -> MatchInfo -> Bool
+matchglob glob (MatchingFile fi) =
#ifdef WITH_TDFA
case cregex of
Right r -> case execute r (matchFile fi) of
@@ -108,6 +108,7 @@ matchglob glob fi =
#else
wildCheckCase glob (matchFile fi)
#endif
+matchglob _ (MatchingKey _) = False
{- Adds a limit to skip files not believed to be present
- in a specfied repository. -}
@@ -115,14 +116,11 @@ addIn :: String -> Annex ()
addIn = addLimit . limitIn
limitIn :: MkLimit
-limitIn name = Right $ \notpresent -> check $
+limitIn name = Right $ \notpresent -> checkKey $
if name == "."
then inhere notpresent
else inremote notpresent
where
- check a = lookupFile >=> handle a
- handle _ Nothing = return False
- handle a (Just (key, _)) = a key
inremote notpresent key = do
u <- Remote.nameToUUID name
us <- Remote.keyLocations key
@@ -137,22 +135,20 @@ limitIn name = Right $ \notpresent -> check $
{- Limit to content that is currently present on a uuid. -}
limitPresent :: Maybe UUID -> MkLimit
-limitPresent u _ = Right $ const $ check $ \key -> do
+limitPresent u _ = Right $ const $ checkKey $ \key -> do
hereu <- getUUID
if u == Just hereu || isNothing u
then inAnnex key
else do
us <- Remote.keyLocations key
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 -}
limitInDir :: FilePath -> MkLimit
-limitInDir dir = const $ Right $ const $ \fi -> return $
- any (== dir) $ splitPath $ takeDirectory $ matchFile fi
+limitInDir dir = const $ Right $ const go
+ 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
- of copies. -}
@@ -169,10 +165,9 @@ limitCopies want = case split ":" want of
where
go num good = case readish num of
Nothing -> Left "bad number for copies"
- Just n -> Right $ \notpresent f ->
- lookupFile f >>= handle n good notpresent
- handle _ _ _ Nothing = return False
- handle n good notpresent (Just (key, _)) = do
+ Just n -> Right $ \notpresent -> checkKey $
+ handle n good notpresent
+ handle n good notpresent key = do
us <- filter (`S.notMember` notpresent)
<$> (filterM good =<< Remote.keyLocations key)
return $ length us >= n
@@ -192,11 +187,10 @@ addInAllGroup groupname = do
limitInAllGroup :: GroupMap -> MkLimit
limitInAllGroup m groupname
| S.null want = Right $ const $ const $ return True
- | otherwise = Right $ \notpresent -> lookupFile >=> check notpresent
+ | otherwise = Right $ \notpresent -> checkKey $ check notpresent
where
want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
- check _ Nothing = return False
- check notpresent (Just (key, _))
+ check notpresent key
-- optimisation: Check if a wanted uuid is notpresent.
| not (S.null (S.intersection want notpresent)) = return False
| otherwise = do
@@ -208,10 +202,9 @@ addInBackend :: String -> Annex ()
addInBackend = addLimit . limitInBackend
limitInBackend :: MkLimit
-limitInBackend name = Right $ const $ lookupFile >=> check
+limitInBackend name = Right $ const $ checkKey check
where
- wanted = Backend.lookupBackendName name
- check = return . maybe False ((==) wanted . snd)
+ check key = pure $ keyBackendName key == name
{- Adds a limit to skip files that are too large or too small -}
addLargerThan :: String -> Annex ()
@@ -225,8 +218,10 @@ limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ go sz
where
- go sz _ fi = lookupFile fi >>= check fi sz
- check _ sz (Just (key, _)) = return $ keySize key `vs` Just sz
+ go sz _ (MatchingFile fi) = lookupFile fi >>= check fi 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
filesize <- liftIO $ catchMaybeIO $
fromIntegral . fileSize
@@ -249,3 +244,10 @@ addTimeLimit s = do
lookupFile :: FileInfo -> Annex (Maybe (Key, Backend))
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
diff --git a/Limit/Wanted.hs b/Limit/Wanted.hs
index ed4529dea..7e9278202 100644
--- a/Limit/Wanted.hs
+++ b/Limit/Wanted.hs
@@ -13,9 +13,11 @@ import Limit
import Types.FileMatcher
addWantGet :: Annex ()
-addWantGet = addLimit $ Right $ const $
- \fileinfo -> wantGet False (Just $ matchFile fileinfo)
+addWantGet = addLimit $ Right $ const $ checkWant $ wantGet False
addWantDrop :: Annex ()
-addWantDrop = addLimit $ Right $ const $
- \fileinfo -> wantDrop False Nothing (Just $ matchFile fileinfo)
+addWantDrop = addLimit $ Right $ const $ checkWant $ wantDrop False Nothing
+
+checkWant :: (Maybe FilePath -> Annex Bool) -> MatchInfo -> Annex Bool
+checkWant a (MatchingFile fi) = a (Just $ matchFile fi)
+checkWant _ (MatchingKey _) = return False
diff --git a/Seek.hs b/Seek.hs
index a4e9a2fe5..4b3281a56 100644
--- a/Seek.hs
+++ b/Seek.hs
@@ -165,7 +165,7 @@ prepFiltered a fs = do
matcher <- Limit.getMatcher
map (process matcher) <$> fs
where
- process matcher f = ifM (matcher $ FileInfo f f)
+ process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
( a f , return Nothing )
notSymlink :: FilePath -> IO Bool
diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs
index fc442b604..e2d4eadc1 100644
--- a/Types/FileMatcher.hs
+++ b/Types/FileMatcher.hs
@@ -7,6 +7,12 @@
module Types.FileMatcher where
+import Types.Key (Key)
+
+data MatchInfo
+ = MatchingFile FileInfo
+ | MatchingKey Key
+
data FileInfo = FileInfo
{ relFile :: FilePath -- may be relative to cwd
, matchFile :: FilePath -- filepath to match on; may be relative to top
diff --git a/Types/Limit.hs b/Types/Limit.hs
index 4436f6953..2b009a758 100644
--- a/Types/Limit.hs
+++ b/Types/Limit.hs
@@ -17,4 +17,4 @@ import qualified Data.Set as S
type MkLimit = String -> Either String MatchFiles
type AssumeNotPresent = S.Set UUID
-type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool
+type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool