-- |
-- Module     : Simulation.Aivika.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.Gate
       (Gate,
        newGate,
        newGateOpened,
        newGateClosed,
        openGate,
        closeGate,
        invertGate,
        gateOpened,
        gateClosed,
        awaitGateOpened,
        awaitGateClosed,
        gateChanged_) where

import Control.Monad

import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.Process
import Simulation.Aivika.Signal
import Simulation.Aivika.Ref

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

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

-- | Create a new initially open gate.
newGateOpened :: Simulation Gate
newGateOpened :: Simulation Gate
newGateOpened = Bool -> Simulation Gate
newGate Bool
True

-- | Create a new initially close gate.
newGateClosed :: Simulation Gate
newGateClosed :: Simulation Gate
newGateClosed = Bool -> Simulation Gate
newGate Bool
False

-- | Open the gate if it was closed.
openGate :: Gate -> Event ()
openGate :: Gate -> Event ()
openGate Gate
gate =
  Ref Bool -> Bool -> Event ()
forall a. Ref a -> a -> Event ()
writeRef (Gate -> Ref Bool
gateRef Gate
gate) Bool
True

-- | Close the gate if it was open.
closeGate :: Gate -> Event ()
closeGate :: Gate -> Event ()
closeGate Gate
gate =
  Ref Bool -> Bool -> Event ()
forall a. Ref a -> a -> Event ()
writeRef (Gate -> Ref Bool
gateRef Gate
gate) Bool
False

-- | Invert the gate.
invertGate :: Gate -> Event ()
invertGate :: Gate -> Event ()
invertGate Gate
gate =
  Ref Bool -> (Bool -> Bool) -> Event ()
forall a. Ref a -> (a -> a) -> Event ()
modifyRef (Gate -> Ref Bool
gateRef Gate
gate) Bool -> Bool
not

-- | Test whether the gate is open.
gateOpened :: Gate -> Event Bool
gateOpened :: Gate -> Event Bool
gateOpened Gate
gate =
  Ref Bool -> Event Bool
forall a. Ref a -> Event a
readRef (Gate -> Ref Bool
gateRef Gate
gate)

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

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

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

-- | Signal triggered when the state of the gate changes.
gateChanged_ :: Gate -> Signal ()
gateChanged_ :: Gate -> Signal ()
gateChanged_ Gate
gate =
  Ref Bool -> Signal ()
forall a. Ref a -> Signal ()
refChanged_ (Gate -> Ref Bool
gateRef Gate
gate)