summaryrefslogtreecommitdiff
path: root/events/src/Events
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-05-27 18:51:48 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-05-27 18:51:48 +0200
commite04e707b1fb63b7857878e2d77c560abe3efd51b (patch)
tree589638b4f9eeab4a4ed664d42940e2bfb7c7f727 /events/src/Events
parentaed36a51b3942a3050ee8cf45424798f22354d73 (diff)
downloadevents-e04e707b1fb63b7857878e2d77c560abe3efd51b.tar
events-e04e707b1fb63b7857878e2d77c560abe3efd51b.tar.gz
events-e04e707b1fb63b7857878e2d77c560abe3efd51b.tar.bz2
events-e04e707b1fb63b7857878e2d77c560abe3efd51b.tar.xz
events-e04e707b1fb63b7857878e2d77c560abe3efd51b.zip
Dynamically compute commands
Diffstat (limited to 'events/src/Events')
-rw-r--r--events/src/Events/Spec.hs31
1 files changed, 17 insertions, 14 deletions
diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs
index 1e7e1b4..2af3446 100644
--- a/events/src/Events/Spec.hs
+++ b/events/src/Events/Spec.hs
@@ -1,10 +1,13 @@
1{-# LANGUAGE GADTs #-}
2
1module Events.Spec 3module Events.Spec
2 ( interpret 4 ( interpret
3 , Spec, Expr(..), BoolExpr(..) 5 , Spec, Cmnd(..), Expr(..)
4 ) where 6 ) where
5 7
6import Events.Types 8import Events.Types
7 9
10import Control.Monad ((<=<))
8import Control.Monad.IO.Class 11import Control.Monad.IO.Class
9import Control.Monad.State.Lazy 12import Control.Monad.State.Lazy
10 13
@@ -14,23 +17,23 @@ import Control.Lens
14 17
15import Debug.Trace 18import Debug.Trace
16 19
17type Spec = [Expr] -- most significant last 20type Spec = [Expr Cmnd] -- most significant last
18 21
19data Expr = Override Object 22data Cmnd = COverride Object
20 | Occurs BoolExpr 23 | COccurs Bool
21 | Nop 24 | CNop
22 deriving (Show) 25 deriving (Show)
23 26
24data BoolExpr = BoolLit Bool 27data Expr a where
25 deriving (Show) 28 ELit :: a -> Expr a
26 29
27interpret :: MonadIO m => Spec -> Eval m () 30interpret :: MonadIO m => Spec -> Eval m ()
28interpret = mapM_ interpretExpr 31interpret = mapM_ $ interpretCmnd <=< interpretExpr
29 32
30interpretExpr :: MonadIO m => Expr -> Eval m () 33interpretExpr :: MonadIO m => Expr Cmnd -> m Cmnd
31interpretExpr (Override obj) = objPayload ?= obj 34interpretExpr (ELit a) = return a
32interpretExpr (Occurs expr) = objOccurs <~ interpretBoolExpr expr
33interpretExpr _ = return ()
34 35
35interpretBoolExpr :: Monad m => BoolExpr -> Eval m Bool 36interpretCmnd :: MonadIO m => Cmnd -> Eval m ()
36interpretBoolExpr (BoolLit v) = return v 37interpretCmnd (COverride obj) = objPayload ?= obj
38interpretCmnd (COccurs b) = objOccurs .= b
39interpretCmnd _ = return ()