summaryrefslogtreecommitdiff
path: root/events/src/Events/Types.hs
blob: 711e20004088f5cfa1e9bbd0682268c0317cdfae (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
{-# LANGUAGE TemplateHaskell #-}

module Events.Types
       ( TimeRange(..), rangeStart, rangeDuration
       , Event(..), payload, occursWithin
       , EvalCtx(..), ctxEvents
       , ObjCtx(..), objVars, objOccurs, objPayload, objCtx
       , Eval
       , module Data.Aeson
       , module Data.Time.Clock
       , module Data.Default.Class
       , module Events.Types.NDT
       , module Control.Monad.State.Lazy
       ) where

import Control.Lens.TH (makeLenses)
import Control.Lens
  
import Data.Aeson hiding ((.=))

import Data.Time.Clock

import Data.Default.Class

import Events.Types.NDT (NDT, foldNDT)

import Control.Monad.State.Lazy

data TimeRange = TimeRange
                 { _rangeStart :: UTCTime
                 , _rangeDuration :: NominalDiffTime
                 }
makeLenses ''TimeRange

data Event = Event
             { _payload :: Object
             , _occursWithin :: TimeRange -> Bool
             }
makeLenses ''Event

data EvalCtx = EvalCtx
               { _ctxEvents :: [Object]
               } deriving (Show)
makeLenses ''EvalCtx

instance Default EvalCtx where
  def = EvalCtx
        { _ctxEvents = mempty
        }

data ObjCtx = ObjCtx
              { _objOccurs :: Bool
              , _objPayload :: Maybe Object
              , _objVars :: Object
              }
makeLenses ''ObjCtx

instance Default ObjCtx where
  def = ObjCtx
        { _objOccurs = True
        , _objPayload = Nothing
        , _objVars = mempty
        }

objCtx :: Traversal' ObjCtx Object
objCtx fObj ctx
  | _objOccurs ctx = traverseOf (objPayload . _Just) fObj ctx
  | otherwise      = pure ctx

type Eval m a = StateT ObjCtx (NDT (StateT EvalCtx m)) a