summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-09-20 00:49:40 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-09-20 00:49:40 -0400
commit52533799535ebe1c133e2687ff1c5612d5bdb51d (patch)
treea30db8d442a4aa49d8cc45b5dc589b7a5a68b4dc
parenta1578e33dce4a9e7dcbd700077fc73237c35d19a (diff)
convert Token to have separate constructors for each peice of syntax
-rw-r--r--Limit.hs18
-rw-r--r--Options.hs4
-rw-r--r--Utility/Matcher.hs67
3 files changed, 50 insertions, 39 deletions
diff --git a/Limit.hs b/Limit.hs
index f57895aee..b3b041396 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -48,17 +48,17 @@ add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
prepend (Left ls) = Left $ l:ls
prepend _ = error "internal"
-{- Adds a new limit. -}
-addlimit :: (FilePath -> Annex Bool) -> Annex ()
-addlimit = add . Utility.Matcher.Operation
-
{- Adds a new token. -}
-token :: String -> Annex ()
-token = add . Utility.Matcher.Token
+addToken :: String -> Annex ()
+addToken = add . Utility.Matcher.token
+
+{- Adds a new limit. -}
+addLimit :: (FilePath -> Annex Bool) -> Annex ()
+addLimit = add . Utility.Matcher.Operation
{- Add a limit to skip files that do not match the glob. -}
addExclude :: String -> Annex ()
-addExclude glob = addlimit $ return . notExcluded
+addExclude glob = addLimit $ return . notExcluded
where
notExcluded f = isNothing $ match cregex f []
cregex = compile regex []
@@ -69,7 +69,7 @@ addExclude glob = addlimit $ return . notExcluded
addIn :: String -> Annex ()
addIn name = do
u <- Remote.nameToUUID name
- addlimit $ if name == "." then check local else check (remote u)
+ addLimit $ if name == "." then check local else check (remote u)
where
check a f = Backend.lookupFile f >>= handle a
handle _ Nothing = return False
@@ -85,7 +85,7 @@ addCopies :: String -> Annex ()
addCopies num = do
case readMaybe num :: Maybe Int of
Nothing -> error "bad number for --copies"
- Just n -> addlimit $ check n
+ Just n -> addLimit $ check n
where
check n f = Backend.lookupFile f >>= handle n
handle _ Nothing = return False
diff --git a/Options.hs b/Options.hs
index 44d5f3674..eeb3639b4 100644
--- a/Options.hs
+++ b/Options.hs
@@ -58,5 +58,5 @@ matcherOptions =
, shortopt ")" "close group of options"
]
where
- longopt o d = Option [] [o] (NoArg (token o)) d
- shortopt o d = Option o [] (NoArg (token o)) d
+ longopt o d = Option [] [o] (NoArg (addToken o)) d
+ shortopt o d = Option o [] (NoArg (addToken o)) d
diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs
index 342775d68..323a84bfd 100644
--- a/Utility/Matcher.hs
+++ b/Utility/Matcher.hs
@@ -18,6 +18,7 @@
module Utility.Matcher (
Token(..),
Matcher,
+ token,
generate,
match,
matchM,
@@ -26,20 +27,30 @@ module Utility.Matcher (
import Control.Monad
-{- A Token can either be a single word, or an Operation of an arbitrary type. -}
-data Token op = Token String | Operation op
+{- A Token can be an Operation of an arbitrary type, or one of a few
+ - predefined peices of syntax. -}
+data Token op = Operation op | And | Or | Not | Open | Close
deriving (Show, Eq)
-data Matcher op = Any
- | And (Matcher op) (Matcher op)
- | Or (Matcher op) (Matcher op)
- | Not (Matcher op)
- | Op op
+data Matcher op = MAny
+ | MAnd (Matcher op) (Matcher op)
+ | MOr (Matcher op) (Matcher op)
+ | MNot (Matcher op)
+ | MOp op
deriving (Show, Eq)
+{- Converts a word of syntax into a token. Doesn't handle operations. -}
+token :: String -> Token op
+token "and" = And
+token "or" = Or
+token "not" = Not
+token "(" = Open
+token ")" = Close
+token t = error $ "unknown token " ++ t
+
{- Converts a list of Tokens into a Matcher. -}
generate :: [Token op] -> Matcher op
-generate ts = generate' Any ts
+generate ts = generate' MAny ts
generate' :: Matcher op -> [Token op] -> Matcher op
generate' m [] = m
generate' m ts = uncurry generate' $ consume m ts
@@ -48,16 +59,16 @@ generate' m ts = uncurry generate' $ consume m ts
- and returns unconsumed Tokens. -}
consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
consume m [] = (m, [])
-consume m ((Operation o):ts) = (m `And` Op o, ts)
-consume m ((Token t):ts)
- | t == "and" = cont $ m `And` next
- | t == "or" = cont $ m `Or` next
- | t == "not" = cont $ m `And` (Not next)
- | t == "(" = let (n, r) = consume next rest in (m `And` n, r)
- | t == ")" = (m, ts)
- | otherwise = error $ "unknown token " ++ t
+consume m (t:ts) = go t
where
- (next, rest) = consume Any ts
+ go And = cont $ m `MAnd` next
+ go Or = cont $ m `MOr` next
+ go Not = cont $ m `MAnd` (MNot next)
+ go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
+ go Close = (m, ts)
+ go (Operation o) = (m `MAnd` MOp o, ts)
+
+ (next, rest) = consume MAny ts
cont v = (v, rest)
{- Checks if a Matcher matches, using a supplied function to check
@@ -65,25 +76,25 @@ consume m ((Token t):ts)
match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
match a m v = go m
where
- go Any = True
- go (And m1 m2) = go m1 && go m2
- go (Or m1 m2) = go m1 || go m2
- go (Not m1) = not (go m1)
- go (Op o) = a o v
+ go MAny = True
+ go (MAnd m1 m2) = go m1 && go m2
+ go (MOr m1 m2) = go m1 || go m2
+ go (MNot m1) = not (go m1)
+ go (MOp o) = a o v
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
matchM m v = go m
where
- go Any = return True
- go (And m1 m2) = liftM2 (&&) (go m1) (go m2)
- go (Or m1 m2) = liftM2 (||) (go m1) (go m2)
- go (Not m1) = liftM not (go m1)
- go (Op o) = o v
+ go MAny = return True
+ go (MAnd m1 m2) = liftM2 (&&) (go m1) (go m2)
+ go (MOr m1 m2) = liftM2 (||) (go m1) (go m2)
+ go (MNot m1) = liftM not (go m1)
+ go (MOp o) = o v
{- Checks is a matcher contains no limits, and so (presumably) matches
- anything. Note that this only checks the trivial case; it is possible
- to construct matchers that match anything but are more complicated. -}
matchesAny :: Matcher a -> Bool
-matchesAny Any = True
+matchesAny MAny = True
matchesAny _ = False