diff options
| -rw-r--r-- | Annex.hs | 3 | ||||
| -rw-r--r-- | Limit.hs | 47 | ||||
| -rw-r--r-- | Logs/PreferredContent.hs | 6 |
3 files changed, 35 insertions, 21 deletions
@@ -52,6 +52,7 @@ import Types.UUID import Utility.State import qualified Utility.Matcher import qualified Data.Map as M +import qualified Data.Set as S -- git-annex's monad newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a } @@ -76,7 +77,7 @@ instance MonadBaseControl IO Annex where type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a) -type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (FilePath -> Annex Bool)) +type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FilePath -> Annex Bool)) -- internal state storage data AnnexState = AnnexState @@ -18,13 +18,15 @@ import qualified Utility.Matcher import qualified Remote import qualified Backend import Annex.Content +import Annex.UUID import Logs.Trust import Types.TrustLevel import Logs.Group import Utility.HumanTime -type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) -type MkLimit = String -> Either String (FilePath -> Annex Bool) +type MatchFiles = AssumeNotPresent -> FilePath -> Annex Bool +type MkLimit = String -> Either String MatchFiles +type AssumeNotPresent = S.Set UUID {- Checks if there are user-specified limits. -} limited :: Annex Bool @@ -46,7 +48,7 @@ getMatcher' = do return matcher {- Adds something to the limit list, which is built up reversed. -} -add :: Limit -> Annex () +add :: Utility.Matcher.Token (FilePath -> Annex Bool) -> Annex () add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s } where prepend (Left ls) = Left $ l:ls @@ -57,22 +59,22 @@ addToken :: String -> Annex () addToken = add . Utility.Matcher.token {- Adds a new limit. -} -addLimit :: Either String (FilePath -> Annex Bool) -> Annex () -addLimit = either error (add . Utility.Matcher.Operation) +addLimit :: Either String MatchFiles -> Annex () +addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty) {- Add a limit to skip files that do not match the glob. -} addInclude :: String -> Annex () addInclude = addLimit . limitInclude limitInclude :: MkLimit -limitInclude glob = Right $ return . matchglob glob +limitInclude glob = Right $ const $ return . matchglob glob {- Add a limit to skip files that match the glob. -} addExclude :: String -> Annex () addExclude = addLimit . limitExclude limitExclude :: MkLimit -limitExclude glob = Right $ return . not . matchglob glob +limitExclude glob = Right $ const $ return . not . matchglob glob matchglob :: String -> FilePath -> Bool matchglob glob f = isJust $ match cregex f [] @@ -86,15 +88,25 @@ addIn :: String -> Annex () addIn = addLimit . limitIn limitIn :: MkLimit -limitIn name = Right $ check $ if name == "." then inAnnex else inremote +limitIn name = Right $ \notpresent -> check $ + if name == "." + then inhere notpresent + else inremote notpresent where check a = Backend.lookupFile >=> handle a handle _ Nothing = return False handle a (Just (key, _)) = a key - inremote key = do + inremote notpresent key = do u <- Remote.nameToUUID name us <- Remote.keyLocations key - return $ u `elem` us + return $ u `elem` us && u `S.notMember` notpresent + inhere notpresent key + | S.null notpresent = inAnnex key + | otherwise = do + u <- getUUID + if u `S.member` notpresent + then return False + else inAnnex key {- Adds a limit to skip files not believed to have the specified number - of copies. -} @@ -111,11 +123,12 @@ limitCopies want = case split ":" want of where go num good = case readish num of Nothing -> Left "bad number for copies" - Just n -> Right $ check n good - check n good = Backend.lookupFile >=> handle n good - handle _ _ Nothing = return False - handle n good (Just (key, _)) = do - us <- filterM good =<< Remote.keyLocations key + Just n -> Right $ \notpresent -> + Backend.lookupFile >=> handle n good notpresent + handle _ _ _ Nothing = return False + handle n good notpresent (Just (key, _)) = do + us <- filter (`S.notMember` notpresent) + <$> (filterM good =<< Remote.keyLocations key) return $ length us >= n checktrust t u = (== t) <$> lookupTrust u checkgroup g u = S.member g <$> lookupGroups u @@ -125,7 +138,7 @@ addInBackend :: String -> Annex () addInBackend = addLimit . limitInBackend limitInBackend :: MkLimit -limitInBackend name = Right $ Backend.lookupFile >=> check +limitInBackend name = Right $ const $ Backend.lookupFile >=> check where wanted = Backend.lookupBackendName name check = return . maybe False ((==) wanted . snd) @@ -135,7 +148,7 @@ addTimeLimit s = do let seconds = fromMaybe (error "bad time-limit") $ parseDuration s start <- liftIO getPOSIXTime let cutoff = start + seconds - addLimit $ Right $ const $ do + addLimit $ Right $ const $ const $ do now <- liftIO getPOSIXTime if now > cutoff then do diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index f482ac57b..77e4f2705 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -20,7 +20,7 @@ import Common.Annex import qualified Annex.Branch import qualified Annex import Logs.UUIDBased -import Limit (limitInclude, limitExclude, limitIn, limitCopies, limitInBackend) +import Limit (MatchFiles, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend) import qualified Utility.Matcher {- Filename of preferred-content.log. -} @@ -56,7 +56,7 @@ preferredContentMapRaw = simpleMap . parseLog Just - because the configuration is shared amoung repositories and newer - versions of git-annex may add new features. Instead, parse errors - result in a Matcher that will always succeed. -} -makeMatcher :: String -> Utility.Matcher.Matcher (FilePath -> Annex Bool) +makeMatcher :: String -> Utility.Matcher.Matcher MatchFiles makeMatcher s | null (lefts tokens) = Utility.Matcher.generate $ rights tokens | otherwise = Utility.Matcher.generate [] @@ -69,7 +69,7 @@ checkPreferredContentExpression s = case lefts $ map parseToken $ tokenizeMatche [] -> Nothing l -> Just $ unwords $ map ("Parse failure: " ++) l -parseToken :: String -> Either String (Utility.Matcher.Token (FilePath -> Annex Bool)) +parseToken :: String -> Either String (Utility.Matcher.Token MatchFiles) parseToken t | any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t | otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m |