{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} module Events.Types ( TimeRange(..), rangeStart, rangeDuration , Event(..), payload, occursWithin , SpecCtx(..), ctxVars, ctxEvents , Spec, interpret , 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.Reader 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 SpecCtx = SpecCtx { _ctxVars :: Object , _ctxEvents :: [Event] } makeLenses ''SpecCtx instance Default SpecCtx where def = SpecCtx { _ctxVars = mempty , _ctxEvents = mempty } type Spec m a = ListT (ReaderT SpecCtx m) a interpret :: MonadFix m => Spec m (Maybe Event) -> m [Event] interpret x = catMaybes <$> mfix x' where x' = runReaderT (ListT.toList x) . flip (set ctxEvents) def . catMaybes