{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

-- |
-- Module     : Simulation.Aivika.Trans.Ref
-- 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
--
-- This module defines an updatable reference that depends on the event queue.
--
module Simulation.Aivika.Trans.Ref
       (Ref,
        refChanged,
        refChanged_,
        newRef,
        newRef0,
        readRef,
        writeRef,
        modifyRef) where

import Data.IORef

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Signal
import qualified Simulation.Aivika.Trans.Ref.Base as B
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Observable

-- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable 
-- but only dependent on the event queue, which allows synchronizing the reference
-- with the model explicitly through the 'Event' monad.
data Ref m a = 
  Ref { Ref m a -> Ref m a
refValue :: B.Ref m a, 
        Ref m a -> SignalSource m a
refChangedSource :: SignalSource m a }

-- | Create a new reference.
newRef :: MonadDES m => a -> Simulation m (Ref m a)
{-# INLINABLE newRef #-}
newRef :: a -> Simulation m (Ref m a)
newRef a
a =
  (Run m -> m (Ref m a)) -> Simulation m (Ref m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Ref m a)) -> Simulation m (Ref m a))
-> (Run m -> m (Ref m a)) -> Simulation m (Ref m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m a
x <- Run m -> Simulation m (Ref m a) -> m (Ref m a)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m a) -> m (Ref m a))
-> Simulation m (Ref m a) -> m (Ref m a)
forall a b. (a -> b) -> a -> b
$ a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
B.newRef a
a
     SignalSource m a
s <- Run m -> Simulation m (SignalSource m a) -> m (SignalSource m a)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r Simulation m (SignalSource m a)
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     Ref m a -> m (Ref m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref :: forall (m :: * -> *) a. Ref m a -> SignalSource m a -> Ref m a
Ref { refValue :: Ref m a
refValue = Ref m a
x, 
                  refChangedSource :: SignalSource m a
refChangedSource = SignalSource m a
s }

-- | Create a new reference within more low level computation than 'Simulation'.
newRef0 :: (MonadDES m, B.MonadRef0 m) => a -> m (Ref m a)
{-# INLINABLE newRef0 #-}
newRef0 :: a -> m (Ref m a)
newRef0 a
a =
  do Ref m a
x <- a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef0 m => a -> m (Ref m a)
B.newRef0 a
a
     SignalSource m a
s <- m (SignalSource m a)
forall (m :: * -> *) a.
(MonadDES m, MonadRef0 m) =>
m (SignalSource m a)
newSignalSource0
     Ref m a -> m (Ref m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref :: forall (m :: * -> *) a. Ref m a -> SignalSource m a -> Ref m a
Ref { refValue :: Ref m a
refValue = Ref m a
x, 
                  refChangedSource :: SignalSource m a
refChangedSource = SignalSource m a
s }
     
-- | Read the value of a reference.
readRef :: MonadDES m => Ref m a -> Event m a
{-# INLINE readRef #-}
readRef :: Ref m a -> Event m a
readRef Ref m a
r = Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
B.readRef (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r)

-- | Write a new value into the reference.
writeRef :: MonadDES m => Ref m a -> a -> Event m ()
{-# INLINABLE writeRef #-}
writeRef :: Ref m a -> a -> Event m ()
writeRef Ref m a
r a
a = (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  do a
a a -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
B.writeRef (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r) a
a
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m a -> a -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Ref m a -> SignalSource m a
forall (m :: * -> *) a. Ref m a -> SignalSource m a
refChangedSource Ref m a
r) a
a

-- | Mutate the contents of the reference.
modifyRef :: MonadDES m => Ref m a -> (a -> a) -> Event m ()
{-# INLINABLE modifyRef #-}
modifyRef :: Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m a
r a -> a
f = (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  do a
a <- Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m a -> m a) -> Event m a -> m a
forall a b. (a -> b) -> a -> b
$ Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
B.readRef (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r)
     let b :: a
b = a -> a
f a
a
     a
b a -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
B.writeRef (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r) a
b
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m a -> a -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Ref m a -> SignalSource m a
forall (m :: * -> *) a. Ref m a -> SignalSource m a
refChangedSource Ref m a
r) a
b

-- | Return a signal that notifies about every change of the reference state.
refChanged :: Ref m a -> Signal m a
{-# INLINE refChanged #-}
refChanged :: Ref m a -> Signal m a
refChanged Ref m a
r = SignalSource m a -> Signal m a
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (Ref m a -> SignalSource m a
forall (m :: * -> *) a. Ref m a -> SignalSource m a
refChangedSource Ref m a
r)

-- | Return a signal that notifies about every change of the reference state.
refChanged_ :: MonadDES m => Ref m a -> Signal m ()
{-# INLINABLE refChanged_ #-}
refChanged_ :: Ref m a -> Signal m ()
refChanged_ Ref m a
r = (a -> ()) -> Signal m a -> Signal m ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal (() -> a -> ()
forall a b. a -> b -> a
const ()) (Signal m a -> Signal m ()) -> Signal m a -> Signal m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> Signal m a
forall (m :: * -> *) a. Ref m a -> Signal m a
refChanged Ref m a
r

instance MonadDES m => Eq (Ref m a) where

  {-# INLINE (==) #-}
  Ref m a
r1 == :: Ref m a -> Ref m a -> Bool
== Ref m a
r2 = (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r1) Ref m a -> Ref m a -> Bool
forall a. Eq a => a -> a -> Bool
== (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r2)

instance (MonadDES m, Observable (B.Ref m) (t m))  => Observable (Ref m) (t m) where

  {-# INLINE readObservable #-}
  readObservable :: Ref m a -> t m a
readObservable Ref m a
r = Ref m a -> t m a
forall (o :: * -> *) (m :: * -> *) a. Observable o m => o a -> m a
readObservable (Ref m a -> Ref m a
forall (m :: * -> *) a. Ref m a -> Ref m a
refValue Ref m a
r)