{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} module Events.Types ( TimeRange(..), rangeStart, rangeDuration , Event(..), payload, occursWithin , EvalCtx(..), ctxVars, ctxEvents , Eval, evaluate , module Data.Aeson , module Data.Time.Clock , module Data.Default.Class ) where import Control.Lens.TH import Data.Aeson (Object) import Data.Time.Clock import Control.Monad.State.Lazy import ListT (ListT) import qualified ListT import Data.Default.Class import Data.Monoid import Control.Monad.Fix import Control.Lens import Data.Maybe data TimeRange = TimeRange { _rangeStart :: UTCTime , _rangeDuration :: NominalDiffTime } makeLenses ''TimeRange data Event = Event { _payload :: Object , _occursWithin :: TimeRange -> Bool } makeLenses ''Event data EvalCtx = EvalCtx { _ctxVars :: Object , _ctxEvents :: [Event] } makeLenses ''EvalCtx instance Default EvalCtx where def = EvalCtx { _ctxVars = mempty , _ctxEvents = mempty } type Eval m a = ListT (StateT EvalCtx m) a evaluate :: MonadFix m => Eval m (Maybe Event) -> m [Event] evaluate x = catMaybes <$> mfix x' where x' = evalStateT (ListT.toList x) . flip (set ctxEvents) def . catMaybes