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 | ||
