-- |
-- Module     : Simulation.Aivika.RealTime.RT
-- Copyright  : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This module defines a soft real-time computation based on 'IO'.
--
module Simulation.Aivika.RealTime.RT
       (-- * Soft real-time computation
        RT,
        RTParams(..),
        RTContext,
        RTScaling(..),
        runRT,
        defaultRTParams,
        newRTContext,
        rtParams,
        rtScale,
        -- * Invoking actions within the simulation
        applyEventRT,
        applyEventRT_,
        enqueueEventRT,
        enqueueEventRT_) where

import Control.Monad
import Control.Monad.Trans

import Control.Concurrent.STM
import Control.Concurrent.Async

import Simulation.Aivika.Trans
import Simulation.Aivika.IO.Comp
import Simulation.Aivika.IO.Ref.Base
import Simulation.Aivika.IO.QueueStrategy
import Simulation.Aivika.IO.Exception

import Simulation.Aivika.RealTime.Internal.RT
import Simulation.Aivika.RealTime.Internal.Channel
import Simulation.Aivika.RealTime.Event
import Simulation.Aivika.RealTime.QueueStrategy
import Simulation.Aivika.RealTime.Comp
import Simulation.Aivika.RealTime.Ref.Base.Lazy
import Simulation.Aivika.RealTime.Ref.Base.Strict

-- | An implementation of the 'MonadDES' type class.
instance (Monad m, MonadIO m, MonadException m, MonadComp m) => MonadDES (RT m) where

  {-# SPECIALIZE instance MonadDES (RT IO) #-}

-- | An implementation of the 'EventIOQueueing' type class.
instance (Monad m, MonadIO m, MonadException m) => EventIOQueueing (RT m) where

  {-# SPECIALIZE instance EventIOQueueing (RT IO) #-}

  enqueueEventIO :: Double -> Event (RT m) () -> Event (RT m) ()
enqueueEventIO = forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent

-- | Invoke the action within the soft real-time simulation.
invokeEventRT_ :: MonadIO m
                  => RTContext m
                  -- ^ the computation context
                  -> (Event (RT m) () -> Event (RT m) ())
                  -- ^ the computation transform
                  -> Event (RT m) ()
                  -- ^ the computation to invoke
                  -> m ()
                  -- ^ the action of invoking the computation
{-# INLINABLE invokeEventRT_ #-}
invokeEventRT_ :: forall (m :: * -> *).
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ()) -> Event (RT m) () -> m ()
invokeEventRT_ RTContext m
ctx Event (RT m) () -> Event (RT m) ()
f Event (RT m) ()
m =
  let ch :: Channel (Event (RT m) ())
ch = forall (m :: * -> *). RTContext m -> Channel (Event (RT m) ())
rtChannel0 RTContext m
ctx
  in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Channel a -> a -> IO ()
writeChannel Channel (Event (RT m) ())
ch forall a b. (a -> b) -> a -> b
$ Event (RT m) () -> Event (RT m) ()
f Event (RT m) ()
m

-- | Invoke the action within the soft real-time simulation.
invokeEventRT :: MonadIO m
                 => RTContext m
                 -- ^ the computation context
                 -> (Event (RT m) () -> Event (RT m) ())
                 -- ^ the computation transform
                 -> Event (RT m) a
                 -- ^ the computation to invoke
                 -> m (Async a)
                 -- ^ the result of computation
{-# INLINABLE invokeEventRT #-}
invokeEventRT :: forall (m :: * -> *) a.
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ())
-> Event (RT m) a
-> m (Async a)
invokeEventRT RTContext m
ctx Event (RT m) () -> Event (RT m) ()
f Event (RT m) a
m =
  do let ch :: Channel (Event (RT m) ())
ch = forall (m :: * -> *). RTContext m -> Channel (Event (RT m) ())
rtChannel0 RTContext m
ctx
     TVar (Maybe a)
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
newTVarIO forall a. Maybe a
Nothing
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. Channel a -> a -> IO ()
writeChannel Channel (Event (RT m) ())
ch forall a b. (a -> b) -> a -> b
$
       Event (RT m) () -> Event (RT m) ()
f forall a b. (a -> b) -> a -> b
$
       do a
a <- Event (RT m) a
m
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
            forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe a)
v (forall a. a -> Maybe a
Just a
a)
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$
       forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
       do Maybe a
b <- forall a. TVar a -> STM a
readTVar TVar (Maybe a)
v
          case Maybe a
b of
            Just a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            Maybe a
Nothing -> forall a. STM a
retry

-- | Apply the 'Event' computation within the soft real-time simulation
-- with the specified context and return the result.
applyEventRT :: MonadIO m => RTContext m -> Event (RT m) a -> m (Async a)
{-# INLINABLE applyEventRT #-}
applyEventRT :: forall (m :: * -> *) a.
MonadIO m =>
RTContext m -> Event (RT m) a -> m (Async a)
applyEventRT RTContext m
ctx Event (RT m) a
m = forall (m :: * -> *) a.
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ())
-> Event (RT m) a
-> m (Async a)
invokeEventRT RTContext m
ctx forall a. a -> a
id Event (RT m) a
m

-- | Apply the 'Event' computation within the soft real-time simulation
-- with the specified context.
applyEventRT_ :: MonadIO m => RTContext m -> Event (RT m) () -> m ()
{-# INLINABLE applyEventRT_ #-}
applyEventRT_ :: forall (m :: * -> *).
MonadIO m =>
RTContext m -> Event (RT m) () -> m ()
applyEventRT_ RTContext m
ctx Event (RT m) ()
m = forall (m :: * -> *).
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ()) -> Event (RT m) () -> m ()
invokeEventRT_ RTContext m
ctx forall a. a -> a
id Event (RT m) ()
m

-- | Enqueue the 'Event' computation within the soft real-time simulation
-- with the specified context at the modeling time provided and
-- then return the result.
enqueueEventRT :: MonadIO m => RTContext m -> Double -> Event (RT m) a -> m (Async a)
{-# INLINABLE enqueueEventRT #-}
enqueueEventRT :: forall (m :: * -> *) a.
MonadIO m =>
RTContext m -> Double -> Event (RT m) a -> m (Async a)
enqueueEventRT RTContext m
ctx Double
t Event (RT m) a
m = forall (m :: * -> *) a.
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ())
-> Event (RT m) a
-> m (Async a)
invokeEventRT RTContext m
ctx (forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t) Event (RT m) a
m

-- | Enqueue the 'Event' computation within the soft real-time simulation
-- with the specified context at the modeling time provided.
enqueueEventRT_ :: MonadIO m => RTContext m -> Double -> Event (RT m) () -> m ()
{-# INLINABLE enqueueEventRT_ #-}
enqueueEventRT_ :: forall (m :: * -> *).
MonadIO m =>
RTContext m -> Double -> Event (RT m) () -> m ()
enqueueEventRT_ RTContext m
ctx Double
t Event (RT m) ()
m = forall (m :: * -> *).
MonadIO m =>
RTContext m
-> (Event (RT m) () -> Event (RT m) ()) -> Event (RT m) () -> m ()
invokeEventRT_ RTContext m
ctx (forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t) Event (RT m) ()
m