{-# LANGUAGE TypeFamilies #-}

-- |
-- Module     : Simulation.Aivika.IO.Ref.Base.Strict
-- Copyright  : Copyright (c) 2009-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 'IO' monad in an instance of strict 'MonadRef'.
--
module Simulation.Aivika.IO.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

-- | 'IO' is an instance of 'MonadRef'.
instance MonadRef IO where
-- instance (Monad m, MonadIO m, MonadTemplate m) => MonadRef m where

  {-# SPECIALISE instance MonadRef IO #-}

  -- | A type safe wrapper for the 'IORef' reference.
  newtype Ref IO a = Ref { Ref IO a -> IORef a
refValue :: IORef a }

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

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

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

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

-- | 'IO' is an instance of 'MonadRef0'.
instance MonadRef0 IO where
-- instance (MonadIO m, MonadTemplate m) => MonadRef0 m where

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