convert Token to have separate constructors for each peice of syntax

This commit is contained in:
Joey Hess 2011-09-20 00:49:40 -04:00
parent a1578e33dc
commit 5253379953
3 changed files with 50 additions and 39 deletions

View file

@ -48,17 +48,17 @@ add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
prepend (Left ls) = Left $ l:ls prepend (Left ls) = Left $ l:ls
prepend _ = error "internal" prepend _ = error "internal"
{- Adds a new limit. -}
addlimit :: (FilePath -> Annex Bool) -> Annex ()
addlimit = add . Utility.Matcher.Operation
{- Adds a new token. -} {- Adds a new token. -}
token :: String -> Annex () addToken :: String -> Annex ()
token = add . Utility.Matcher.Token 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. -} {- Add a limit to skip files that do not match the glob. -}
addExclude :: String -> Annex () addExclude :: String -> Annex ()
addExclude glob = addlimit $ return . notExcluded addExclude glob = addLimit $ return . notExcluded
where where
notExcluded f = isNothing $ match cregex f [] notExcluded f = isNothing $ match cregex f []
cregex = compile regex [] cregex = compile regex []
@ -69,7 +69,7 @@ addExclude glob = addlimit $ return . notExcluded
addIn :: String -> Annex () addIn :: String -> Annex ()
addIn name = do addIn name = do
u <- Remote.nameToUUID name 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 where
check a f = Backend.lookupFile f >>= handle a check a f = Backend.lookupFile f >>= handle a
handle _ Nothing = return False handle _ Nothing = return False
@ -85,7 +85,7 @@ addCopies :: String -> Annex ()
addCopies num = do addCopies num = do
case readMaybe num :: Maybe Int of case readMaybe num :: Maybe Int of
Nothing -> error "bad number for --copies" Nothing -> error "bad number for --copies"
Just n -> addlimit $ check n Just n -> addLimit $ check n
where where
check n f = Backend.lookupFile f >>= handle n check n f = Backend.lookupFile f >>= handle n
handle _ Nothing = return False handle _ Nothing = return False

View file

@ -58,5 +58,5 @@ matcherOptions =
, shortopt ")" "close group of options" , shortopt ")" "close group of options"
] ]
where where
longopt o d = Option [] [o] (NoArg (token o)) d longopt o d = Option [] [o] (NoArg (addToken o)) d
shortopt o d = Option o [] (NoArg (token o)) d shortopt o d = Option o [] (NoArg (addToken o)) d

View file

@ -18,6 +18,7 @@
module Utility.Matcher ( module Utility.Matcher (
Token(..), Token(..),
Matcher, Matcher,
token,
generate, generate,
match, match,
matchM, matchM,
@ -26,20 +27,30 @@ module Utility.Matcher (
import Control.Monad import Control.Monad
{- A Token can either be a single word, or an Operation of an arbitrary type. -} {- A Token can be an Operation of an arbitrary type, or one of a few
data Token op = Token String | Operation op - predefined peices of syntax. -}
data Token op = Operation op | And | Or | Not | Open | Close
deriving (Show, Eq) deriving (Show, Eq)
data Matcher op = Any data Matcher op = MAny
| And (Matcher op) (Matcher op) | MAnd (Matcher op) (Matcher op)
| Or (Matcher op) (Matcher op) | MOr (Matcher op) (Matcher op)
| Not (Matcher op) | MNot (Matcher op)
| Op op | MOp op
deriving (Show, Eq) 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. -} {- Converts a list of Tokens into a Matcher. -}
generate :: [Token op] -> Matcher op generate :: [Token op] -> Matcher op
generate ts = generate' Any ts generate ts = generate' MAny ts
generate' :: Matcher op -> [Token op] -> Matcher op generate' :: Matcher op -> [Token op] -> Matcher op
generate' m [] = m generate' m [] = m
generate' m ts = uncurry generate' $ consume m ts generate' m ts = uncurry generate' $ consume m ts
@ -48,16 +59,16 @@ generate' m ts = uncurry generate' $ consume m ts
- and returns unconsumed Tokens. -} - and returns unconsumed Tokens. -}
consume :: Matcher op -> [Token op] -> (Matcher op, [Token op]) consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
consume m [] = (m, []) consume m [] = (m, [])
consume m ((Operation o):ts) = (m `And` Op o, ts) consume m (t:ts) = go t
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
where 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) cont v = (v, rest)
{- Checks if a Matcher matches, using a supplied function to check {- 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 :: (op -> v -> Bool) -> Matcher op -> v -> Bool
match a m v = go m match a m v = go m
where where
go Any = True go MAny = True
go (And m1 m2) = go m1 && go m2 go (MAnd m1 m2) = go m1 && go m2
go (Or m1 m2) = go m1 || go m2 go (MOr m1 m2) = go m1 || go m2
go (Not m1) = not (go m1) go (MNot m1) = not (go m1)
go (Op o) = a o v go (MOp o) = a o v
{- Runs a monadic Matcher, where Operations are actions in the monad. -} {- Runs a monadic Matcher, where Operations are actions in the monad. -}
matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
matchM m v = go m matchM m v = go m
where where
go Any = return True go MAny = return True
go (And m1 m2) = liftM2 (&&) (go m1) (go m2) go (MAnd m1 m2) = liftM2 (&&) (go m1) (go m2)
go (Or m1 m2) = liftM2 (||) (go m1) (go m2) go (MOr m1 m2) = liftM2 (||) (go m1) (go m2)
go (Not m1) = liftM not (go m1) go (MNot m1) = liftM not (go m1)
go (Op o) = o v go (MOp o) = o v
{- Checks is a matcher contains no limits, and so (presumably) matches {- Checks is a matcher contains no limits, and so (presumably) matches
- anything. Note that this only checks the trivial case; it is possible - anything. Note that this only checks the trivial case; it is possible
- to construct matchers that match anything but are more complicated. -} - to construct matchers that match anything but are more complicated. -}
matchesAny :: Matcher a -> Bool matchesAny :: Matcher a -> Bool
matchesAny Any = True matchesAny MAny = True
matchesAny _ = False matchesAny _ = False