add a value to match against to match and matchM

This commit is contained in:
Joey Hess 2011-09-18 17:47:24 -04:00
parent 3e15187ac1
commit 38c0f3eaf8

View file

@ -17,9 +17,10 @@
module Utility.Matcher ( module Utility.Matcher (
Token(..), Token(..),
Matcher,
generate, generate,
match, match,
run matchM
) where ) where
import Control.Monad import Control.Monad
@ -62,21 +63,21 @@ consume m ((Token t):ts)
{- Checks if a Matcher matches, using a supplied function to check {- Checks if a Matcher matches, using a supplied function to check
- the value of Operations. -} - the value of Operations. -}
match :: (op -> Bool) -> Matcher op -> Bool match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
match a = go match a m v = go m
where where
go Any = True go Any = True
go (And m1 m2) = go m1 && go m2 go (And m1 m2) = go m1 && go m2
go (Or m1 m2) = go m1 || go m2 go (Or m1 m2) = go m1 || go m2
go (Not m1) = not (go m1) go (Not m1) = not (go m1)
go (Op v) = a v go (Op 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. -}
run :: Monad m => Matcher (m Bool) -> m Bool matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
run = go matchM m v = go m
where where
go Any = return True go Any = return True
go (And m1 m2) = liftM2 (&&) (go m1) (go m2) go (And m1 m2) = liftM2 (&&) (go m1) (go m2)
go (Or m1 m2) = liftM2 (||) (go m1) (go m2) go (Or m1 m2) = liftM2 (||) (go m1) (go m2)
go (Not m1) = liftM not (go m1) go (Not m1) = liftM not (go m1)
go (Op o) = o -- run o go (Op o) = o v