summaryrefslogtreecommitdiff
path: root/events/src/Events/Types.hs
diff options
context:
space:
mode:
authorGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-31 00:23:23 +0200
committerGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-31 00:23:23 +0200
commitd22086666632b707aa210f20ecf10a8cd4e6d4fe (patch)
treedd561d380898dfb0a0e8fc6d98249c965c19c221 /events/src/Events/Types.hs
parent41d0a0c8c3a66ce48756ad8c2ab0ea87933047c9 (diff)
downloadevents-d22086666632b707aa210f20ecf10a8cd4e6d4fe.tar
events-d22086666632b707aa210f20ecf10a8cd4e6d4fe.tar.gz
events-d22086666632b707aa210f20ecf10a8cd4e6d4fe.tar.bz2
events-d22086666632b707aa210f20ecf10a8cd4e6d4fe.tar.xz
events-d22086666632b707aa210f20ecf10a8cd4e6d4fe.zip
Lambda calculus for computing events at runtime
Diffstat (limited to 'events/src/Events/Types.hs')
-rw-r--r--events/src/Events/Types.hs20
1 files changed, 17 insertions, 3 deletions
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 @@
1{-# LANGUAGE TemplateHaskell #-} 1{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving #-}
2 2
3module Events.Types 3module Events.Types
4 ( TimeRange(..), rangeStart, rangeDuration 4 ( TimeRange(..), rangeStart, rangeDuration
5 , Event(..), payload, occursWithin 5 , Event(..), payload, occursWithin
6 , EvalCtx(..), ctxEvents 6 , EvalCtx(..), ctxEvents
7 , ObjCtx(..), objVars, objOccurs, objPayload, objCtx 7 , ObjCtx(..), objVars, objOccurs, objPayload, objCtx
8 , Eval 8 , Eval(..)
9 , module Data.Aeson 9 , module Data.Aeson
10 , module Data.Time.Clock 10 , module Data.Time.Clock
11 , module Data.Default.Class 11 , module Data.Default.Class
@@ -28,6 +28,8 @@ import Events.Types.NDT (NDT, foldNDT)
28import Control.Monad.State.Lazy 28import Control.Monad.State.Lazy
29import Control.Monad.Reader 29import Control.Monad.Reader
30 30
31import Control.Applicative (Alternative(..))
32
31data TimeRange = TimeRange 33data TimeRange = TimeRange
32 { _rangeStart :: UTCTime 34 { _rangeStart :: UTCTime
33 , _rangeDuration :: NominalDiffTime 35 , _rangeDuration :: NominalDiffTime
@@ -69,4 +71,16 @@ objCtx fObj ctx
69 | ctx ^. objOccurs = traverseOf (objPayload . _Just) fObj ctx 71 | ctx ^. objOccurs = traverseOf (objPayload . _Just) fObj ctx
70 | otherwise = pure ctx 72 | otherwise = pure ctx
71 73
72type Eval m a = StateT ObjCtx (NDT (ReaderT EvalCtx m)) a 74newtype Eval m a = Eval { unEval :: StateT ObjCtx (NDT (ReaderT EvalCtx m)) a }
75 deriving ( MonadState ObjCtx
76 , MonadReader EvalCtx
77 , MonadIO
78 , Functor
79 , Applicative
80 , Alternative
81 , Monad
82 , MonadPlus
83 )
84
85instance MonadTrans Eval where
86 lift = Eval . lift . lift . lift