diff options
-rw-r--r-- | events/src/Events/Spec.hs | 31 | ||||
-rw-r--r-- | events/src/Main.hs | 15 |
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 | |||
1 | module Events.Spec | 3 | module Events.Spec |
2 | ( interpret | 4 | ( interpret |
3 | , Spec, Expr(..), BoolExpr(..) | 5 | , Spec, Cmnd(..), Expr(..) |
4 | ) where | 6 | ) where |
5 | 7 | ||
6 | import Events.Types | 8 | import Events.Types |
7 | 9 | ||
10 | import Control.Monad ((<=<)) | ||
8 | import Control.Monad.IO.Class | 11 | import Control.Monad.IO.Class |
9 | import Control.Monad.State.Lazy | 12 | import Control.Monad.State.Lazy |
10 | 13 | ||
@@ -14,23 +17,23 @@ import Control.Lens | |||
14 | 17 | ||
15 | import Debug.Trace | 18 | import Debug.Trace |
16 | 19 | ||
17 | type Spec = [Expr] -- most significant last | 20 | type Spec = [Expr Cmnd] -- most significant last |
18 | 21 | ||
19 | data Expr = Override Object | 22 | data Cmnd = COverride Object |
20 | | Occurs BoolExpr | 23 | | COccurs Bool |
21 | | Nop | 24 | | CNop |
22 | deriving (Show) | 25 | deriving (Show) |
23 | 26 | ||
24 | data BoolExpr = BoolLit Bool | 27 | data Expr a where |
25 | deriving (Show) | 28 | ELit :: a -> Expr a |
26 | 29 | ||
27 | interpret :: MonadIO m => Spec -> Eval m () | 30 | interpret :: MonadIO m => Spec -> Eval m () |
28 | interpret = mapM_ interpretExpr | 31 | interpret = mapM_ $ interpretCmnd <=< interpretExpr |
29 | 32 | ||
30 | interpretExpr :: MonadIO m => Expr -> Eval m () | 33 | interpretExpr :: MonadIO m => Expr Cmnd -> m Cmnd |
31 | interpretExpr (Override obj) = objPayload ?= obj | 34 | interpretExpr (ELit a) = return a |
32 | interpretExpr (Occurs expr) = objOccurs <~ interpretBoolExpr expr | ||
33 | interpretExpr _ = return () | ||
34 | 35 | ||
35 | interpretBoolExpr :: Monad m => BoolExpr -> Eval m Bool | 36 | interpretCmnd :: MonadIO m => Cmnd -> Eval m () |
36 | interpretBoolExpr (BoolLit v) = return v | 37 | interpretCmnd (COverride obj) = objPayload ?= obj |
38 | interpretCmnd (COccurs b) = objOccurs .= b | ||
39 | interpretCmnd _ = 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 | |||
18 | import qualified ListT | 18 | import qualified ListT |
19 | 19 | ||
20 | main :: IO () | 20 | main :: IO () |
21 | main = 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 |
28 | main = undefined | ||