summaryrefslogtreecommitdiff
path: root/events
diff options
context:
space:
mode:
Diffstat (limited to 'events')
-rw-r--r--events/src/Events/Spec.hs31
-rw-r--r--events/src/Main.hs15
2 files changed, 25 insertions, 21 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 ()
diff --git a/events/src/Main.hs b/events/src/Main.hs
index 0026a8a..0454f22 100644
--- a/events/src/Main.hs
+++ b/events/src/Main.hs
@@ -18,10 +18,11 @@ import Debug.Trace
18import qualified ListT 18import qualified ListT
19 19
20main :: IO () 20main :: IO ()
21main = test $ [ Nop 21-- main = test $ [ Nop
22 , Override [("blub", String "Haha!")] 22-- , Override [("blub", String "Haha!")]
23 , Occurs (BoolLit True) 23-- , Occurs True
24 , Occurs (BoolLit False) 24-- , Occurs False
25 ] 25-- ]
26 where 26-- where
27 test = CBS.putStr . Yaml.encode <=< evaluate . interpret 27-- test = CBS.putStr . Yaml.encode <=< evaluate . interpret
28main = undefined