-- |
-- Module     : Simulation.Aivika.Trans.Gate
-- 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 module defines a gate which can be either opened or closed.
--
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

-- | Represents a gate, which can be either opened or closed.
data Gate m = Gate { forall (m :: * -> *). Gate m -> Ref m Bool
gateRef :: Ref m Bool }

-- | Create a new gate, specifying whether the gate is initially open.
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 <- forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Bool
opened
     forall (m :: * -> *) a. Monad m => a -> m a
return Gate { gateRef :: Ref m Bool
gateRef = Ref m Bool
r }

-- | Create a new initially open gate.
newGateOpened :: MonadDES m => Simulation m (Gate m)
{-# INLINE newGateOpened #-}
newGateOpened :: forall (m :: * -> *). MonadDES m => Simulation m (Gate m)
newGateOpened = forall (m :: * -> *). MonadDES m => Bool -> Simulation m (Gate m)
newGate Bool
True

-- | Create a new initially close gate.
newGateClosed :: MonadDES m => Simulation m (Gate m)
{-# INLINE newGateClosed #-}
newGateClosed :: forall (m :: * -> *). MonadDES m => Simulation m (Gate m)
newGateClosed = forall (m :: * -> *). MonadDES m => Bool -> Simulation m (Gate m)
newGate Bool
False

-- | Open the gate if it was closed.
openGate :: MonadDES m => Gate m -> Event m ()
{-# INLINE openGate #-}
openGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
openGate Gate m
gate =
  forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool
True

-- | Close the gate if it was open.
closeGate :: MonadDES m => Gate m -> Event m ()
{-# INLINE closeGate #-}
closeGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
closeGate Gate m
gate =
  forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool
False

-- | Invert the gate.
invertGate :: MonadDES m => Gate m -> Event m ()
{-# INLINABLE invertGate #-}
invertGate :: forall (m :: * -> *). MonadDES m => Gate m -> Event m ()
invertGate Gate m
gate =
  forall (m :: * -> *) a.
MonadDES m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate) Bool -> Bool
not

-- | Test whether the gate is open.
gateOpened :: MonadDES m => Gate m -> Event m Bool
{-# INLINE gateOpened #-}
gateOpened :: forall (m :: * -> *). MonadDES m => Gate m -> Event m Bool
gateOpened Gate m
gate =
  forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)

-- | Test whether the gate is closed.
gateClosed :: MonadDES m => Gate m -> Event m Bool
{-# INLINE gateClosed #-}
gateClosed :: forall (m :: * -> *). MonadDES m => Gate m -> Event m Bool
gateClosed Gate m
gate =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)

-- | Await the gate to be opened if required. If the gate is already open
-- then the computation returns immediately.
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
          forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateOpened Gate m
gate

-- | Await the gate to be closed if required. If the gate is already closed
-- then the computation returns immediately.
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$
       do forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)
          forall (m :: * -> *). MonadDES m => Gate m -> Process m ()
awaitGateClosed Gate m
gate

-- | Signal triggered when the state of the gate changes.
gateChanged_ :: MonadDES m => Gate m -> Signal m ()
{-# INLINE gateChanged_ #-}
gateChanged_ :: forall (m :: * -> *). MonadDES m => Gate m -> Signal m ()
gateChanged_ Gate m
gate =
  forall (m :: * -> *) a. MonadDES m => Ref m a -> Signal m ()
refChanged_ (forall (m :: * -> *). Gate m -> Ref m Bool
gateRef Gate m
gate)