From e04e707b1fb63b7857878e2d77c560abe3efd51b Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 27 May 2016 18:51:48 +0200 Subject: Dynamically compute commands --- events/src/Events/Spec.hs | 31 +++++++++++++++++-------------- 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 @@ +{-# LANGUAGE GADTs #-} + module Events.Spec ( interpret - , Spec, Expr(..), BoolExpr(..) + , Spec, Cmnd(..), Expr(..) ) where import Events.Types +import Control.Monad ((<=<)) import Control.Monad.IO.Class import Control.Monad.State.Lazy @@ -14,23 +17,23 @@ import Control.Lens import Debug.Trace -type Spec = [Expr] -- most significant last +type Spec = [Expr Cmnd] -- most significant last -data Expr = Override Object - | Occurs BoolExpr - | Nop +data Cmnd = COverride Object + | COccurs Bool + | CNop deriving (Show) -data BoolExpr = BoolLit Bool - deriving (Show) +data Expr a where + ELit :: a -> Expr a interpret :: MonadIO m => Spec -> Eval m () -interpret = mapM_ interpretExpr +interpret = mapM_ $ interpretCmnd <=< interpretExpr -interpretExpr :: MonadIO m => Expr -> Eval m () -interpretExpr (Override obj) = objPayload ?= obj -interpretExpr (Occurs expr) = objOccurs <~ interpretBoolExpr expr -interpretExpr _ = return () +interpretExpr :: MonadIO m => Expr Cmnd -> m Cmnd +interpretExpr (ELit a) = return a -interpretBoolExpr :: Monad m => BoolExpr -> Eval m Bool -interpretBoolExpr (BoolLit v) = return v +interpretCmnd :: MonadIO m => Cmnd -> Eval m () +interpretCmnd (COverride obj) = objPayload ?= obj +interpretCmnd (COccurs b) = objOccurs .= b +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 import qualified ListT main :: IO () -main = test $ [ Nop - , Override [("blub", String "Haha!")] - , Occurs (BoolLit True) - , Occurs (BoolLit False) - ] - where - test = CBS.putStr . Yaml.encode <=< evaluate . interpret +-- main = test $ [ Nop +-- , Override [("blub", String "Haha!")] +-- , Occurs True +-- , Occurs False +-- ] +-- where +-- test = CBS.putStr . Yaml.encode <=< evaluate . interpret +main = undefined -- cgit v1.2.3