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