-- |
-- Module     : Simulation.Aivika.Distributed.Optimistic.Internal.Ref.Strict
-- Copyright  : Copyright (c) 2015-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- The implementation of mutable strict references.
--
module Simulation.Aivika.Distributed.Optimistic.Internal.Ref.Strict
       (Ref,
        newRef,
        newRef0,
        readRef,
        writeRef,
        modifyRef) where

import Data.IORef

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Internal.Types

import Simulation.Aivika.Distributed.Optimistic.Internal.DIO
import Simulation.Aivika.Distributed.Optimistic.Internal.Event
import Simulation.Aivika.Distributed.Optimistic.Internal.IO
import Simulation.Aivika.Distributed.Optimistic.Internal.UndoableLog

-- | A mutable reference.
newtype Ref a = Ref { forall a. Ref a -> IORef a
refValue :: IORef a }

instance Eq (Ref a) where
  (Ref IORef a
r1) == :: Ref a -> Ref a -> Bool
== (Ref IORef a
r2) = IORef a
r1 IORef a -> IORef a -> Bool
forall a. Eq a => a -> a -> Bool
== IORef a
r2

-- | Create a new reference.
newRef :: a -> Simulation DIO (Ref a)
newRef :: forall a. a -> Simulation DIO (Ref a)
newRef = DIO (Ref a) -> Simulation DIO (Ref a)
forall a. DIO a -> Simulation DIO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadCompTrans t m =>
m a -> t m a
liftComp (DIO (Ref a) -> Simulation DIO (Ref a))
-> (a -> DIO (Ref a)) -> a -> Simulation DIO (Ref a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DIO (Ref a)
forall a. a -> DIO (Ref a)
newRef0

-- | Create a new reference.
newRef0 :: a -> DIO (Ref a)
newRef0 :: forall a. a -> DIO (Ref a)
newRef0 a
a =
  do IORef a
x <- IO (IORef a) -> DIO (IORef a)
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO (IORef a) -> DIO (IORef a)) -> IO (IORef a) -> DIO (IORef a)
forall a b. (a -> b) -> a -> b
$ a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a
     Ref a -> DIO (Ref a)
forall a. a -> DIO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref { refValue :: IORef a
refValue = IORef a
x }
     
-- | Read the value of a reference.
readRef :: Ref a -> Event DIO a
readRef :: forall a. Ref a -> Event DIO a
readRef Ref a
r = (Point DIO -> DIO a) -> Event DIO a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point DIO -> DIO a) -> Event DIO a)
-> (Point DIO -> DIO a) -> Event DIO a
forall a b. (a -> b) -> a -> b
$ \Point DIO
p ->
  IO a -> DIO a
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO a -> DIO a) -> IO a -> DIO a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r)

-- | Write a new value into the reference.
writeRef :: Ref a -> a -> Event DIO ()
writeRef :: forall a. Ref a -> a -> Event DIO ()
writeRef Ref a
r a
a = (Point DIO -> DIO ()) -> Event DIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point DIO -> DIO ()) -> Event DIO ())
-> (Point DIO -> DIO ()) -> Event DIO ()
forall a b. (a -> b) -> a -> b
$ \Point DIO
p ->
  do let log :: UndoableLog
log = EventQueue DIO -> UndoableLog
queueLog (EventQueue DIO -> UndoableLog) -> EventQueue DIO -> UndoableLog
forall a b. (a -> b) -> a -> b
$ Run DIO -> EventQueue DIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Point DIO -> Run DIO
forall (m :: * -> *). Point m -> Run m
pointRun Point DIO
p)
     a
a0 <- IO a -> DIO a
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO a -> DIO a) -> IO a -> DIO a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r)
     Point DIO -> Event DIO () -> DIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point DIO
p (Event DIO () -> DIO ()) -> Event DIO () -> DIO ()
forall a b. (a -> b) -> a -> b
$
       UndoableLog -> DIO () -> Event DIO ()
writeLog UndoableLog
log (DIO () -> Event DIO ()) -> DIO () -> Event DIO ()
forall a b. (a -> b) -> a -> b
$
       IO () -> DIO ()
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO () -> DIO ()) -> IO () -> DIO ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r) a
a0
     a
a a -> DIO () -> DIO ()
forall a b. a -> b -> b
`seq` IO () -> DIO ()
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO () -> DIO ()) -> IO () -> DIO ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r) a
a

-- | Mutate the contents of the reference.
modifyRef :: Ref a -> (a -> a) -> Event DIO ()
modifyRef :: forall a. Ref a -> (a -> a) -> Event DIO ()
modifyRef Ref a
r a -> a
f = (Point DIO -> DIO ()) -> Event DIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point DIO -> DIO ()) -> Event DIO ())
-> (Point DIO -> DIO ()) -> Event DIO ()
forall a b. (a -> b) -> a -> b
$ \Point DIO
p ->
  do let log :: UndoableLog
log = EventQueue DIO -> UndoableLog
queueLog (EventQueue DIO -> UndoableLog) -> EventQueue DIO -> UndoableLog
forall a b. (a -> b) -> a -> b
$ Run DIO -> EventQueue DIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Point DIO -> Run DIO
forall (m :: * -> *). Point m -> Run m
pointRun Point DIO
p)
     a
a <- IO a -> DIO a
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO a -> DIO a) -> IO a -> DIO a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r)
     let b :: a
b = a -> a
f a
a
     Point DIO -> Event DIO () -> DIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point DIO
p (Event DIO () -> DIO ()) -> Event DIO () -> DIO ()
forall a b. (a -> b) -> a -> b
$
       UndoableLog -> DIO () -> Event DIO ()
writeLog UndoableLog
log (DIO () -> Event DIO ()) -> DIO () -> Event DIO ()
forall a b. (a -> b) -> a -> b
$
       IO () -> DIO ()
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO () -> DIO ()) -> IO () -> DIO ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r) a
a
     a
b a -> DIO () -> DIO ()
forall a b. a -> b -> b
`seq` IO () -> DIO ()
forall a. IO a -> DIO a
forall (m :: * -> *) a. MonadIOUnsafe m => IO a -> m a
liftIOUnsafe (IO () -> DIO ()) -> IO () -> DIO ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref a -> IORef a
forall a. Ref a -> IORef a
refValue Ref a
r) a
b