TimeEval.hs

{-# LANGUAGE AllowAmbiguousTypes      #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE Rank2Types      #-}

module Imprevu.Evaluation.TimeEval where

import Imprevu.Types
import Imprevu.Evaluation.EventEval
import Imprevu.Evaluation.Types
import Data.Time
import Data.Maybe
import Data.Typeable
import Control.Concurrent.STM
import Control.Concurrent
import Control.Monad
import Control.Lens

type Time = Signal UTCTime UTCTime

--launchTimeEvents :: (Monad n) => TVar s -> EvalConfN n s -> IO ()
--launchTimeEvents tv ec = do
--    now <- getCurrentTime
--    --putStrLn $ "tick " ++ (show now)
--    s <- atomically $ readTVar tv
--    let timeEvents = join $ maybeToList $ runEvaluate (getTimeEvents now) (EvalEnv s ec)
--    unless (null timeEvents) $ putStrLn "found time event(s)"
--    mapM_ (triggerTimeEvent tv ec) timeEvents
--    --sleep 30 second roughly
--    threadDelay 30000000
--    launchTimeEvents tv ec

triggerTimeEvent :: (Monad n) => EvalConfN n s -> UTCTime -> s -> s
triggerTimeEvent ec t s = execSignals (return ()) [(Signal t, t)] (EvalEnv s ec)
    --save m'

-- | get all events that has not been triggered yet
getTimeEvents :: UTCTime -> EvaluateN n s [UTCTime]
getTimeEvents now = do
   eis <- use events
   times <- mapM getTimes eis
   return $ filter (\t -> t <= now && t > (-32) `addUTCTime` now) (join times)

getTimes :: EventInfoN n -> EvaluateN n s [UTCTime]
getTimes ei = do
  rss <- getRemainingSignals' ei
  return $ mapMaybe getTime rss

getTime :: SomeSignal -> Maybe UTCTime
getTime (SomeSignal (Signal t)) = cast t
getTime _                    = Nothing