From d22086666632b707aa210f20ecf10a8cd4e6d4fe Mon Sep 17 00:00:00 2001
From: Gregor Kleen <pngwjpgh@users.noreply.github.com>
Date: Sun, 31 Jul 2016 00:23:23 +0200
Subject: Lambda calculus for computing events at runtime

---
 events/src/Events/Types.hs | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

(limited to 'events/src/Events/Types.hs')

diff --git a/events/src/Events/Types.hs b/events/src/Events/Types.hs
index 5320bb3..6a8517b 100644
--- a/events/src/Events/Types.hs
+++ b/events/src/Events/Types.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving #-}
 
 module Events.Types
        ( TimeRange(..), rangeStart, rangeDuration
        , Event(..), payload, occursWithin
        , EvalCtx(..), ctxEvents
        , ObjCtx(..), objVars, objOccurs, objPayload, objCtx
-       , Eval
+       , Eval(..)
        , module Data.Aeson
        , module Data.Time.Clock
        , module Data.Default.Class
@@ -28,6 +28,8 @@ import Events.Types.NDT (NDT, foldNDT)
 import Control.Monad.State.Lazy
 import Control.Monad.Reader
 
+import Control.Applicative (Alternative(..))
+
 data TimeRange = TimeRange
                  { _rangeStart :: UTCTime
                  , _rangeDuration :: NominalDiffTime
@@ -69,4 +71,16 @@ objCtx fObj ctx
   | ctx ^. objOccurs = traverseOf (objPayload . _Just) fObj ctx
   | otherwise        = pure ctx
 
-type Eval m a = StateT ObjCtx (NDT (ReaderT EvalCtx m)) a
+newtype Eval m a = Eval { unEval :: StateT ObjCtx (NDT (ReaderT EvalCtx m)) a }
+  deriving ( MonadState ObjCtx
+           , MonadReader EvalCtx
+           , MonadIO
+           , Functor
+           , Applicative
+           , Alternative
+           , Monad
+           , MonadPlus
+           )
+
+instance MonadTrans Eval where
+  lift = Eval . lift . lift . lift
-- 
cgit v1.2.3