{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving #-}

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
       , module Control.Monad.Reader
       ) 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
import Control.Monad.Reader
import Control.Monad.Catch (MonadThrow)

import Control.Applicative (Alternative(..))

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
  | ctx ^. objOccurs = traverseOf (objPayload . _Just) fObj ctx
  | otherwise        = pure ctx

newtype Eval m a = Eval { unEval :: StateT ObjCtx (NDT (ReaderT EvalCtx m)) a }
  deriving ( MonadState ObjCtx
           , MonadReader EvalCtx
           , MonadIO
           , Functor
           , Applicative
           , Alternative
           , Monad
           , MonadPlus
           , MonadThrow
           )

instance MonadTrans Eval where
  lift = Eval . lift . lift . lift