{-# LANGUAGE TypeFamilies #-}

-- |
-- Module     : Simulation.Aivika.RealTime.Ref.Base.Strict
-- 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
--
-- The 'RT' monad can be an instance of strict 'MonadRef'.
--
module Simulation.Aivika.RealTime.Ref.Base.Strict () where

import Data.IORef

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Ref.Base.Strict

import Simulation.Aivika.RealTime.Internal.RT

-- | The 'RT' monad is an instance of 'MonadRef'.
instance (Monad m, MonadIO m) => MonadRef (RT m) where

  {-# SPECIALISE instance MonadRef (RT IO) #-}

  -- | A type safe wrapper for the 'IORef' reference.
  newtype Ref (RT m) a = Ref { forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue :: IORef a }

  {-# INLINE newRef #-}
  newRef :: forall a. a -> Simulation (RT m) (Ref (RT m) a)
newRef a
a =
    forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run (RT m)
r ->
    do IORef a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef a
a
       forall (m :: * -> *) a. Monad m => a -> m a
return Ref { refValue :: IORef a
refValue = IORef a
x }
     
  {-# INLINE readRef #-}
  readRef :: forall a. Ref (RT m) a -> Event (RT m) a
readRef Ref (RT m) a
r = forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r)

  {-# INLINE writeRef #-}
  writeRef :: forall a. Ref (RT m) a -> a -> Event (RT m) ()
writeRef Ref (RT m) a
r a
a = forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p -> 
    a
a seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r) a
a

  {-# INLINE modifyRef #-}
  modifyRef :: forall a. Ref (RT m) a -> (a -> a) -> Event (RT m) ()
modifyRef Ref (RT m) a
r a -> a
f = forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p -> 
    do a
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r)
       let b :: a
b = a -> a
f a
a
       a
b seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r) a
b

  {-# INLINE equalRef #-}
  equalRef :: forall a. Ref (RT m) a -> Ref (RT m) a -> Bool
equalRef (Ref IORef a
r1) (Ref IORef a
r2) = (IORef a
r1 forall a. Eq a => a -> a -> Bool
== IORef a
r2)

-- | The 'RT' monad is an instance of 'MonadRef0'.
instance MonadIO m => MonadRef0 (RT m) where

  {-# SPECIALISE instance MonadRef0 (RT IO) #-}

  {-# INLINE newRef0 #-}
  newRef0 :: forall a. a -> RT m (Ref (RT m) a)
newRef0 a
a =
    do IORef a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef a
a
       forall (m :: * -> *) a. Monad m => a -> m a
return Ref { refValue :: IORef a
refValue = IORef a
x }