From e04e707b1fb63b7857878e2d77c560abe3efd51b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 27 May 2016 18:51:48 +0200
Subject: Dynamically compute commands

---
 events/src/Events/Spec.hs | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

(limited to 'events/src/Events')

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 ()
-- 
cgit v1.2.3