{-# LANGUAGE TemplateHaskell #-}

module Events.Types
       ( TimeRange(..), rangeStart, rangeDuration
       , Event(..), payload, occursWithin
       , EvalCtx(..), ctxEvents
       , ObjCtx(..), objVars, objOccurs, objPayload
       , Eval, evaluate
       , module Data.Aeson
       , module Data.Time.Clock
       , module Data.Default.Class
       ) where

import Control.Lens.TH (makeLenses)
  
import Data.Aeson (Object)

import Data.Time.Clock (UTCTime, NominalDiffTime)

import Control.Monad.State.Lazy (StateT, evalStateT, execStateT)

import Data.Default.Class (Default(def))

-- import Data.Monoid
import Control.Monad.Fix (MonadFix(mfix))
import Control.Lens ((^.), set)
import Data.Maybe (catMaybes)

-- import Debug.Trace

import Events.Types.NDT (NDT, foldNDT)

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 :: ObjCtx -> Maybe Object
objCtx ctx
  | ctx ^. objOccurs = ctx ^. objPayload
  | otherwise        = Nothing

-- type Eval m a = StateT ObjCtx (ListT (StateT EvalCtx m)) a

-- evaluate :: MonadFix m => Eval m () -> m [Object] {- TODO: Switch to `ListT m Object` – `m [Object]` will turn out to be to strict. There is no instance for `MonadFix (ListT m)` – writing one seems to be possible. -}
-- evaluate x = catMaybes <$> mfix x'
--   where
--     x' = evalStateT (ListT.toList (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes

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

evaluate :: MonadFix m => (Maybe Object -> StateT EvalCtx m Bool) -> Eval m () -> m [Object] {- TODO: Switch to `ListT m Object` – `m [Object]` will turn out to be to strict. There is no instance for `MonadFix (ListT m)` – writing one seems to be possible. -}
evaluate predicate x = catMaybes <$> mfix x'
  where
    x' = evalStateT (foldNDT predicate (objCtx <$> execStateT x def)) . flip (set ctxEvents) def . catMaybes