diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-04-16 22:16:41 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-04-16 22:16:41 +0200 |
commit | 03f321adafd3ef7a169555703ebc8e03903a1450 (patch) | |
tree | d37a3e5bdb608806915e9bd88113cea71d7d8e1a /events/src/Events | |
parent | bfbe2f67cc3fef07db4d0ef9423a2dbc2d002533 (diff) | |
download | events-03f321adafd3ef7a169555703ebc8e03903a1450.tar events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.gz events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.bz2 events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.xz events-03f321adafd3ef7a169555703ebc8e03903a1450.zip |
Specifications to be evaluated
Diffstat (limited to 'events/src/Events')
-rw-r--r-- | events/src/Events/Spec.hs | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs new file mode 100644 index 0000000..deabcc3 --- /dev/null +++ b/events/src/Events/Spec.hs | |||
@@ -0,0 +1,36 @@ | |||
1 | module Events.Spec | ||
2 | ( interpret | ||
3 | , Spec, Expr(..), BoolExpr(..) | ||
4 | ) where | ||
5 | |||
6 | import Events.Types | ||
7 | |||
8 | import Control.Monad.IO.Class | ||
9 | import Control.Monad.State.Lazy | ||
10 | |||
11 | import Data.Monoid | ||
12 | import Data.Foldable | ||
13 | import Control.Lens | ||
14 | |||
15 | import Debug.Trace | ||
16 | |||
17 | type Spec = [Expr] -- most significant last | ||
18 | |||
19 | data Expr = Override Object | ||
20 | | Occurs BoolExpr | ||
21 | | Nop | ||
22 | deriving (Show) | ||
23 | |||
24 | data BoolExpr = BoolLit Bool | ||
25 | deriving (Show) | ||
26 | |||
27 | interpret :: MonadIO m => Spec -> Eval m () | ||
28 | interpret = mapM_ interpretExpr | ||
29 | |||
30 | interpretExpr :: MonadIO m => Expr -> Eval m () | ||
31 | interpretExpr (Override obj) = ctxEvent ?= obj | ||
32 | interpretExpr (Occurs expr) = ctxOccurs <~ interpretBoolExpr expr | ||
33 | interpretExpr _ = return () | ||
34 | |||
35 | interpretBoolExpr :: Monad m => BoolExpr -> Eval m Bool | ||
36 | interpretBoolExpr (BoolLit v) = return v | ||