diff options
author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-31 00:23:23 +0200 |
---|---|---|
committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-31 00:23:23 +0200 |
commit | d22086666632b707aa210f20ecf10a8cd4e6d4fe (patch) | |
tree | dd561d380898dfb0a0e8fc6d98249c965c19c221 /events/src/Events/Types.hs | |
parent | 41d0a0c8c3a66ce48756ad8c2ab0ea87933047c9 (diff) | |
download | events-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.hs | 20 |
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 | ||
3 | module Events.Types | 3 | module 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) | |||
28 | import Control.Monad.State.Lazy | 28 | import Control.Monad.State.Lazy |
29 | import Control.Monad.Reader | 29 | import Control.Monad.Reader |
30 | 30 | ||
31 | import Control.Applicative (Alternative(..)) | ||
32 | |||
31 | data TimeRange = TimeRange | 33 | data 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 | ||
72 | type Eval m a = StateT ObjCtx (NDT (ReaderT EvalCtx m)) a | 74 | newtype 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 | |||
85 | instance MonadTrans Eval where | ||
86 | lift = Eval . lift . lift . lift | ||