aboutsummaryrefslogtreecommitdiff
path: root/Limit.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-29 14:43:34 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-29 14:43:34 -0400
commit9d7ce6bff0c9dcf66983eb100927fc7776c447f9 (patch)
treeb3cf2fe44d25b092b16f08ba3680bf5719dc3a6c /Limit.hs
parentbce30628d5e6df5b64c482bc5fe161576efaaa79 (diff)
reorg matcher types; no non-type code changes
Diffstat (limited to 'Limit.hs')
-rw-r--r--Limit.hs46
1 files changed, 22 insertions, 24 deletions
diff --git a/Limit.hs b/Limit.hs
index 7654842e1..b46ff1a06 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -20,7 +20,6 @@ import Types.TrustLevel
import Types.Key
import Types.Group
import Types.FileMatcher
-import Types.Limit
import Types.MetaData
import Logs.MetaData
import Logs.Group
@@ -45,21 +44,20 @@ getMatcher :: Annex (MatchInfo -> Annex Bool)
getMatcher = Utility.Matcher.matchM <$> getMatcher'
getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool))
-getMatcher' = do
- m <- Annex.getState Annex.limit
- case m of
- Right r -> return r
- Left l -> do
- let matcher = Utility.Matcher.generate (reverse l)
- Annex.changeState $ \s ->
- s { Annex.limit = Right matcher }
- return matcher
+getMatcher' = go =<< Annex.getState Annex.limit
+ where
+ go (CompleteMatcher matcher) = return matcher
+ go (BuildingMatcher l) = do
+ let matcher = Utility.Matcher.generate (reverse l)
+ Annex.changeState $ \s ->
+ s { Annex.limit = CompleteMatcher matcher }
+ return matcher
{- Adds something to the limit list, which is built up reversed. -}
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
+ prepend (BuildingMatcher ls) = BuildingMatcher $ l:ls
prepend _ = error "internal"
{- Adds a new token. -}
@@ -67,21 +65,21 @@ addToken :: String -> Annex ()
addToken = add . Utility.Matcher.token
{- Adds a new limit. -}
-addLimit :: Either String MatchFiles -> Annex ()
+addLimit :: Either String (MatchFiles Annex) -> 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 :: MkLimit Annex
limitInclude glob = Right $ const $ return . matchGlobFile glob
{- Add a limit to skip files that match the glob. -}
addExclude :: String -> Annex ()
addExclude = addLimit . limitExclude
-limitExclude :: MkLimit
+limitExclude :: MkLimit Annex
limitExclude glob = Right $ const $ return . not . matchGlobFile glob
matchGlobFile :: String -> (MatchInfo -> Bool)
@@ -119,10 +117,10 @@ addIn s = addLimit =<< mk
else inAnnex key
{- Limit to content that is currently present on a uuid. -}
-limitPresent :: Maybe UUID -> MkLimit
+limitPresent :: Maybe UUID -> MkLimit Annex
limitPresent u _ = Right $ matchPresent u
-matchPresent :: Maybe UUID -> MatchFiles
+matchPresent :: Maybe UUID -> MatchFiles Annex
matchPresent u _ = checkKey $ \key -> do
hereu <- getUUID
if u == Just hereu || isNothing u
@@ -132,7 +130,7 @@ matchPresent u _ = checkKey $ \key -> do
return $ maybe False (`elem` us) u
{- Limit to content that is in a directory, anywhere in the repository tree -}
-limitInDir :: FilePath -> MkLimit
+limitInDir :: FilePath -> MkLimit Annex
limitInDir dir = const $ Right $ const go
where
go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi
@@ -143,7 +141,7 @@ limitInDir dir = const $ Right $ const go
addCopies :: String -> Annex ()
addCopies = addLimit . limitCopies
-limitCopies :: MkLimit
+limitCopies :: MkLimit Annex
limitCopies want = case split ":" want of
[v, n] -> case parsetrustspec v of
Just checker -> go n $ checktrust checker
@@ -169,7 +167,7 @@ limitCopies want = case split ":" want of
addLackingCopies :: Bool -> String -> Annex ()
addLackingCopies approx = addLimit . limitLackingCopies approx
-limitLackingCopies :: Bool -> MkLimit
+limitLackingCopies :: Bool -> MkLimit Annex
limitLackingCopies approx want = case readish want of
Just needed -> Right $ \notpresent mi -> flip checkKey mi $
handle mi needed notpresent
@@ -191,7 +189,7 @@ limitLackingCopies approx want = case readish want of
- This has a nice optimisation: When a file exists,
- its key is obviously not unused.
-}
-limitUnused :: MatchFiles
+limitUnused :: MatchFiles Annex
limitUnused _ (MatchingFile _) = return False
limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys
@@ -202,7 +200,7 @@ addInAllGroup groupname = do
m <- groupMap
addLimit $ limitInAllGroup m groupname
-limitInAllGroup :: GroupMap -> MkLimit
+limitInAllGroup :: GroupMap -> MkLimit Annex
limitInAllGroup m groupname
| S.null want = Right $ const $ const $ return True
| otherwise = Right $ \notpresent -> checkKey $ check notpresent
@@ -219,7 +217,7 @@ limitInAllGroup m groupname
addInBackend :: String -> Annex ()
addInBackend = addLimit . limitInBackend
-limitInBackend :: MkLimit
+limitInBackend :: MkLimit Annex
limitInBackend name = Right $ const $ checkKey check
where
check key = pure $ keyBackendName key == name
@@ -231,7 +229,7 @@ addLargerThan = addLimit . limitSize (>)
addSmallerThan :: String -> Annex ()
addSmallerThan = addLimit . limitSize (<)
-limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit
+limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex
limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ go sz
@@ -249,7 +247,7 @@ limitSize vs s = case readSize dataUnits s of
addMetaData :: String -> Annex ()
addMetaData = addLimit . limitMetaData
-limitMetaData :: MkLimit
+limitMetaData :: MkLimit Annex
limitMetaData s = case parseMetaData s of
Left e -> Left e
Right (f, v) ->