convert to parameterized types, so the Operation can be any type the caller needs
Especially handy for running a match monadically.
This commit is contained in:
parent
6ebaa85bdb
commit
0e499e67be
1 changed files with 23 additions and 29 deletions
52
Matcher.hs
52
Matcher.hs
|
@ -16,44 +16,39 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Matcher (
|
module Matcher (
|
||||||
Operation(..),
|
|
||||||
Token(..),
|
Token(..),
|
||||||
toMatcher,
|
generate,
|
||||||
match,
|
match,
|
||||||
runMatch
|
run
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
{- An Operation is a command and some parameters. -}
|
{- A Token can either be a single word, or an Operation of an arbitrary type. -}
|
||||||
data Operation = Operation String [String]
|
data Token op = Token String | Operation op
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
{- A Token can either be a single word, or an Operation. -}
|
data Matcher op = Any
|
||||||
data Token = Token String | TokenOp Operation
|
| And (Matcher op) (Matcher op)
|
||||||
deriving (Show, Eq)
|
| Or (Matcher op) (Matcher op)
|
||||||
|
| Not (Matcher op)
|
||||||
data Matcher = Any
|
| Op op
|
||||||
| And Matcher Matcher
|
|
||||||
| Or Matcher Matcher
|
|
||||||
| Not Matcher
|
|
||||||
| Op Operation
|
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
{- Converts a list of Tokens into a Matcher. -}
|
{- Converts a list of Tokens into a Matcher. -}
|
||||||
toMatcher :: [Token] -> Matcher
|
generate :: [Token op] -> Matcher op
|
||||||
toMatcher ts = toMatcher' Any ts
|
generate ts = generate' Any ts
|
||||||
toMatcher' :: Matcher -> [Token] -> Matcher
|
generate' :: Matcher op -> [Token op] -> Matcher op
|
||||||
toMatcher' m [] = m
|
generate' m [] = m
|
||||||
toMatcher' m ts = toMatcher' m' rest
|
generate' m ts = generate' m' rest
|
||||||
where
|
where
|
||||||
(m', rest) = consume m ts
|
(m', rest) = consume m ts
|
||||||
|
|
||||||
{- Consumes one or more tokens, constructs a new Matcher,
|
{- Consumes one or more Tokens, constructs a new Matcher,
|
||||||
- and returns unconsumed tokens. -}
|
- and returns unconsumed Tokens. -}
|
||||||
consume :: Matcher -> [Token] -> (Matcher, [Token])
|
consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
|
||||||
consume m [] = (m, [])
|
consume m [] = (m, [])
|
||||||
consume m ((TokenOp o):ts) = (m `And` Op o, ts)
|
consume m ((Operation o):ts) = (m `And` Op o, ts)
|
||||||
consume m ((Token t):ts)
|
consume m ((Token t):ts)
|
||||||
| t == "and" = cont $ m `And` next
|
| t == "and" = cont $ m `And` next
|
||||||
| t == "or" = cont $ m `Or` next
|
| t == "or" = cont $ m `Or` next
|
||||||
|
@ -67,7 +62,7 @@ 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 :: (Operation -> Bool) -> Matcher -> Bool
|
match :: (op -> Bool) -> Matcher op -> Bool
|
||||||
match a = go
|
match a = go
|
||||||
where
|
where
|
||||||
go Any = True
|
go Any = True
|
||||||
|
@ -76,13 +71,12 @@ match a = go
|
||||||
go (Not m1) = not (go m1)
|
go (Not m1) = not (go m1)
|
||||||
go (Op v) = a v
|
go (Op v) = a v
|
||||||
|
|
||||||
{- Runs a Matcher in an arbitrary monadic contex, using a supplied
|
{- Runs a monadic Matcher, where Operations are actions in the monad. -}
|
||||||
- action to evaluate Operations. -}
|
run :: Monad m => Matcher (m Bool) -> m Bool
|
||||||
runMatch :: Monad m => (Operation -> m Bool) -> Matcher -> m Bool
|
run = go
|
||||||
runMatch a = go
|
|
||||||
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 v) = a v
|
go (Op o) = o -- run o
|
||||||
|
|
Loading…
Add table
Reference in a new issue