module Simulation.Aivika.Trans.Gate
(Gate,
newGate,
newGateOpened,
newGateClosed,
openGate,
closeGate,
invertGate,
gateOpened,
gateClosed,
awaitGateOpened,
awaitGateClosed,
gateChanged_) where
import Control.Monad
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Event
import Simulation.Aivika.Trans.Process
import Simulation.Aivika.Trans.Signal
import Simulation.Aivika.Trans.Ref
data Gate m = Gate { forall (m :: * -> *). Gate m -> Ref m Bool
gateRef :: Ref m Bool }
newGate :: MonadDES m => Bool -> Simulation m (Gate m)
{-# INLINE newGate #-}
newGate :: forall (m :: * -> *). MonadDES m => Bool -> Simulation m (Gate m)
newGate Bool
opened =
do Ref m Bool
r <- Bool -> Simulation m (Ref m Bool)
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Bool
opened
Gate m -> Simulation m (Gate m)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return Gate { gateRef :: Ref m Bool
gateRef = Ref m Bool
r }
newGateOpened :: MonadDES m => Simulation m (Gate m)
{-# INLINE newGateOpened #-}
newGateOpened :: forall (m :: * -> *). MonadDES m => Simulation m (Gate m)
newGateOpened = Bool -> Simulation m (Gate m)
forall (m :: * -> *). MonadDES m => Bool -> Simulation m (Gate m)
newGate Bool
True
newGateClosed :: MonadDES m => Simulation m (Gate m)
{-# INLINE newGateClosed #-}
newGateClosed :: forall (m :: * -> *). MonadDES m => Simulation m (Gate m)
newGateClosed = Bool -> Simulation m (Gate m)
forall (m :: * -> *). MonadDES m => Bool -> Simulation m (Gate m)
newGate Bool
False
openGate :: MonadDES m => Gate m -> Event m ()
{-# INLINE openGate #-}
openGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
openGate Gate m
gate =
Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool
True
closeGate :: MonadDES m => Gate m -> Event m ()
{-# INLINE closeGate #-}
closeGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
closeGate Gate m
gate =
Ref m Bool -> Bool -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool
False
invertGate :: MonadDES m => Gate m -> Event m ()
{-# INLINABLE invertGate #-}
invertGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
invertGate Gate m
gate =
Ref m Bool -> (Bool -> Bool) -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool -> Bool
not
gateOpened :: MonadDES m => Gate m -> Event m Bool
{-# INLINE gateOpened #-}
gateOpened :: forall (m :: * -> *). MonadDES m => Gate m -> Event m Bool
gateOpened Gate m
gate =
Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
gateClosed :: MonadDES m => Gate m -> Event m Bool
{-# INLINE gateClosed #-}
gateClosed :: forall (m :: * -> *). MonadDES m => Gate m -> Event m Bool
gateClosed Gate m
gate =
(Bool -> Bool) -> Event m Bool -> Event m Bool
forall a b. (a -> b) -> Event m a -> Event m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Event m Bool -> Event m Bool) -> Event m Bool -> Event m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
awaitGateOpened :: MonadDES m => Gate m -> Process m ()
{-# INLINABLE awaitGateOpened #-}
awaitGateOpened :: forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateOpened Gate m
gate =
do Bool
f <- Event m Bool -> Process m Bool
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m Bool -> Process m Bool) -> Event m Bool -> Process m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
Bool -> Process m () -> Process m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (Process m () -> Process m ()) -> Process m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
do Signal m () -> Process m ()
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Signal m () -> Process m ()) -> Signal m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Signal m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
Gate m -> Process m ()
forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateOpened Gate m
gate
awaitGateClosed :: MonadDES m => Gate m -> Process m ()
{-# INLINABLE awaitGateClosed #-}
awaitGateClosed :: forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateClosed Gate m
gate =
do Bool
f <- Event m Bool -> Process m Bool
forall a. Event m a -> Process m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m Bool -> Process m Bool) -> Event m Bool -> Process m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
Bool -> Process m () -> Process m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f (Process m () -> Process m ()) -> Process m () -> Process m ()
forall a b. (a -> b) -> a -> b
$
do Signal m () -> Process m ()
forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait (Signal m () -> Process m ()) -> Signal m () -> Process m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Signal m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
Gate m -> Process m ()
forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateClosed Gate m
gate
gateChanged_ :: MonadDES m => Gate m -> Signal m ()
{-# INLINE gateChanged_ #-}
gateChanged_ :: forall (m :: * -> *). MonadDES m => Gate m -> Signal m ()
gateChanged_ Gate m
gate =
Ref m Bool -> Signal m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (Gate m -> Ref m Bool
forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)