add AssumeNotPresent parameter to limits
Solves the issue with preferred content expressions and dropping that I mentioned yesterday. My solution was to add a parameter to specify a set of repositories where content should be assumed not to be present. When deciding whether to drop, it can put the current repository in, and then if the expression fails to match, the content can be dropped. Using yesterday's example "(not copies=trusted:2) and (not in=usbdrive)", when the local repo is one of the 2 trusted copies, the drop check will see only 1 trusted copy, so the expression matches, and so the content will not be dropped.
This commit is contained in:
parent
51f41bad63
commit
7bb4d507ba
3 changed files with 35 additions and 21 deletions
3
Annex.hs
3
Annex.hs
|
@ -52,6 +52,7 @@ import Types.UUID
|
||||||
import Utility.State
|
import Utility.State
|
||||||
import qualified Utility.Matcher
|
import qualified Utility.Matcher
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified Data.Set as S
|
||||||
|
|
||||||
-- git-annex's monad
|
-- git-annex's monad
|
||||||
newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
|
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 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
|
-- internal state storage
|
||||||
data AnnexState = AnnexState
|
data AnnexState = AnnexState
|
||||||
|
|
47
Limit.hs
47
Limit.hs
|
@ -18,13 +18,15 @@ import qualified Utility.Matcher
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Types.TrustLevel
|
import Types.TrustLevel
|
||||||
import Logs.Group
|
import Logs.Group
|
||||||
import Utility.HumanTime
|
import Utility.HumanTime
|
||||||
|
|
||||||
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)
|
type MatchFiles = AssumeNotPresent -> FilePath -> Annex Bool
|
||||||
type MkLimit = String -> Either String (FilePath -> Annex Bool)
|
type MkLimit = String -> Either String MatchFiles
|
||||||
|
type AssumeNotPresent = S.Set UUID
|
||||||
|
|
||||||
{- Checks if there are user-specified limits. -}
|
{- Checks if there are user-specified limits. -}
|
||||||
limited :: Annex Bool
|
limited :: Annex Bool
|
||||||
|
@ -46,7 +48,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 :: Limit -> Annex ()
|
add :: Utility.Matcher.Token (FilePath -> 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
|
||||||
|
@ -57,22 +59,22 @@ addToken :: String -> Annex ()
|
||||||
addToken = add . Utility.Matcher.token
|
addToken = add . Utility.Matcher.token
|
||||||
|
|
||||||
{- Adds a new limit. -}
|
{- Adds a new limit. -}
|
||||||
addLimit :: Either String (FilePath -> Annex Bool) -> Annex ()
|
addLimit :: Either String MatchFiles -> Annex ()
|
||||||
addLimit = either error (add . Utility.Matcher.Operation)
|
addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty)
|
||||||
|
|
||||||
{- Add a limit to skip files that do not match the glob. -}
|
{- Add a limit to skip files that do not match the glob. -}
|
||||||
addInclude :: String -> Annex ()
|
addInclude :: String -> Annex ()
|
||||||
addInclude = addLimit . limitInclude
|
addInclude = addLimit . limitInclude
|
||||||
|
|
||||||
limitInclude :: MkLimit
|
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. -}
|
{- Add a limit to skip files that match the glob. -}
|
||||||
addExclude :: String -> Annex ()
|
addExclude :: String -> Annex ()
|
||||||
addExclude = addLimit . limitExclude
|
addExclude = addLimit . limitExclude
|
||||||
|
|
||||||
limitExclude :: MkLimit
|
limitExclude :: MkLimit
|
||||||
limitExclude glob = Right $ return . not . matchglob glob
|
limitExclude glob = Right $ const $ return . not . matchglob glob
|
||||||
|
|
||||||
matchglob :: String -> FilePath -> Bool
|
matchglob :: String -> FilePath -> Bool
|
||||||
matchglob glob f = isJust $ match cregex f []
|
matchglob glob f = isJust $ match cregex f []
|
||||||
|
@ -86,15 +88,25 @@ addIn :: String -> Annex ()
|
||||||
addIn = addLimit . limitIn
|
addIn = addLimit . limitIn
|
||||||
|
|
||||||
limitIn :: MkLimit
|
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
|
where
|
||||||
check a = Backend.lookupFile >=> handle a
|
check a = Backend.lookupFile >=> handle a
|
||||||
handle _ Nothing = return False
|
handle _ Nothing = return False
|
||||||
handle a (Just (key, _)) = a key
|
handle a (Just (key, _)) = a key
|
||||||
inremote key = do
|
inremote notpresent key = do
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
us <- Remote.keyLocations key
|
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
|
{- Adds a limit to skip files not believed to have the specified number
|
||||||
- of copies. -}
|
- of copies. -}
|
||||||
|
@ -111,11 +123,12 @@ 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 $ check n good
|
Just n -> Right $ \notpresent ->
|
||||||
check n good = Backend.lookupFile >=> handle n good
|
Backend.lookupFile >=> handle n good notpresent
|
||||||
handle _ _ Nothing = return False
|
handle _ _ _ Nothing = return False
|
||||||
handle n good (Just (key, _)) = do
|
handle n good notpresent (Just (key, _)) = do
|
||||||
us <- filterM good =<< Remote.keyLocations key
|
us <- filter (`S.notMember` notpresent)
|
||||||
|
<$> (filterM good =<< Remote.keyLocations key)
|
||||||
return $ length us >= n
|
return $ length us >= n
|
||||||
checktrust t u = (== t) <$> lookupTrust u
|
checktrust t u = (== t) <$> lookupTrust u
|
||||||
checkgroup g u = S.member g <$> lookupGroups u
|
checkgroup g u = S.member g <$> lookupGroups u
|
||||||
|
@ -125,7 +138,7 @@ addInBackend :: String -> Annex ()
|
||||||
addInBackend = addLimit . limitInBackend
|
addInBackend = addLimit . limitInBackend
|
||||||
|
|
||||||
limitInBackend :: MkLimit
|
limitInBackend :: MkLimit
|
||||||
limitInBackend name = Right $ Backend.lookupFile >=> check
|
limitInBackend name = Right $ const $ Backend.lookupFile >=> check
|
||||||
where
|
where
|
||||||
wanted = Backend.lookupBackendName name
|
wanted = Backend.lookupBackendName name
|
||||||
check = return . maybe False ((==) wanted . snd)
|
check = return . maybe False ((==) wanted . snd)
|
||||||
|
@ -135,7 +148,7 @@ addTimeLimit s = do
|
||||||
let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
|
let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
|
||||||
start <- liftIO getPOSIXTime
|
start <- liftIO getPOSIXTime
|
||||||
let cutoff = start + seconds
|
let cutoff = start + seconds
|
||||||
addLimit $ Right $ const $ do
|
addLimit $ Right $ const $ const $ do
|
||||||
now <- liftIO getPOSIXTime
|
now <- liftIO getPOSIXTime
|
||||||
if now > cutoff
|
if now > cutoff
|
||||||
then do
|
then do
|
||||||
|
|
|
@ -20,7 +20,7 @@ import Common.Annex
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Logs.UUIDBased
|
import Logs.UUIDBased
|
||||||
import Limit (limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
|
import Limit (MatchFiles, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
|
||||||
import qualified Utility.Matcher
|
import qualified Utility.Matcher
|
||||||
|
|
||||||
{- Filename of preferred-content.log. -}
|
{- Filename of preferred-content.log. -}
|
||||||
|
@ -56,7 +56,7 @@ preferredContentMapRaw = simpleMap . parseLog Just
|
||||||
- because the configuration is shared amoung repositories and newer
|
- because the configuration is shared amoung repositories and newer
|
||||||
- versions of git-annex may add new features. Instead, parse errors
|
- versions of git-annex may add new features. Instead, parse errors
|
||||||
- result in a Matcher that will always succeed. -}
|
- result in a Matcher that will always succeed. -}
|
||||||
makeMatcher :: String -> Utility.Matcher.Matcher (FilePath -> Annex Bool)
|
makeMatcher :: String -> Utility.Matcher.Matcher MatchFiles
|
||||||
makeMatcher s
|
makeMatcher s
|
||||||
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
||||||
| otherwise = Utility.Matcher.generate []
|
| otherwise = Utility.Matcher.generate []
|
||||||
|
@ -69,7 +69,7 @@ checkPreferredContentExpression s = case lefts $ map parseToken $ tokenizeMatche
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
l -> Just $ unwords $ map ("Parse failure: " ++) l
|
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
|
parseToken t
|
||||||
| any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
|
| any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
|
||||||
| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m
|
| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m
|
||||||
|
|
Loading…
Reference in a new issue