-- |
-- Module     : Simulation.Aivika.GPSS.Block.Preempt
-- Copyright  : Copyright (c) 2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.2
--
-- This module defines the GPSS block Preempt.
--
module Simulation.Aivika.GPSS.Block.Preempt
       (preemptBlock,
        PreemptBlockMode(..),
        defaultPreemptBlockMode,
        toFacilityPreemptMode,
        fromFacilityPreemptMode) where

import Simulation.Aivika
import Simulation.Aivika.GPSS.Transact
import Simulation.Aivika.GPSS.Block
import Simulation.Aivika.GPSS.Facility

-- | Specifies the Preempt block mode.
data PreemptBlockMode a =
  PreemptBlockMode { PreemptBlockMode a -> Bool
preemptBlockPriorityMode :: Bool,
                     -- ^ the Priority mode; otherwise, the Interrupt mode
                     PreemptBlockMode a -> Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer :: Maybe (Maybe Double -> Block (Transact a) ()),
                     -- ^ where to transfer the preempted transact,
                     -- passing in the remaining time from the process holding 
                     -- computation such as the ADVANCE block
                     PreemptBlockMode a -> Bool
preemptBlockRemoveMode :: Bool
                     -- ^ the Remove mode
                   }

-- | Convert 'PreemptBlockMode' to 'FacilityPreemptMode'.
toFacilityPreemptMode :: PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode :: PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode PreemptBlockMode a
m =
  FacilityPreemptMode :: forall a.
Bool
-> Maybe (FacilityPreemptTransfer a)
-> Bool
-> FacilityPreemptMode a
FacilityPreemptMode { facilityPriorityMode :: Bool
facilityPriorityMode = PreemptBlockMode a -> Bool
forall a. PreemptBlockMode a -> Bool
preemptBlockPriorityMode PreemptBlockMode a
m,
                        facilityTransfer :: Maybe (FacilityPreemptTransfer a)
facilityTransfer     = Maybe (FacilityPreemptTransfer a)
transfer,
                        facilityRemoveMode :: Bool
facilityRemoveMode   = PreemptBlockMode a -> Bool
forall a. PreemptBlockMode a -> Bool
preemptBlockRemoveMode PreemptBlockMode a
m
                      }
  where
    transfer :: Maybe (FacilityPreemptTransfer a)
transfer =
      case PreemptBlockMode a -> Maybe (Maybe Double -> Block (Transact a) ())
forall a.
PreemptBlockMode a -> Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer PreemptBlockMode a
m of
        Maybe (Maybe Double -> Block (Transact a) ())
Nothing -> Maybe (FacilityPreemptTransfer a)
forall a. Maybe a
Nothing
        Just Maybe Double -> Block (Transact a) ()
f  -> FacilityPreemptTransfer a -> Maybe (FacilityPreemptTransfer a)
forall a. a -> Maybe a
Just (\Transact a
a Maybe Double
dt -> Block (Transact a) () -> Transact a -> Process ()
forall a b. Block a b -> a -> Process b
blockProcess (Maybe Double -> Block (Transact a) ()
f Maybe Double
dt) Transact a
a)

-- | Convert 'PreemptBlockMode' from 'FacilityPreemptMode'.
fromFacilityPreemptMode :: FacilityPreemptMode a -> PreemptBlockMode a
fromFacilityPreemptMode :: FacilityPreemptMode a -> PreemptBlockMode a
fromFacilityPreemptMode FacilityPreemptMode a
m =
  PreemptBlockMode :: forall a.
Bool
-> Maybe (Maybe Double -> Block (Transact a) ())
-> Bool
-> PreemptBlockMode a
PreemptBlockMode { preemptBlockPriorityMode :: Bool
preemptBlockPriorityMode = FacilityPreemptMode a -> Bool
forall a. FacilityPreemptMode a -> Bool
facilityPriorityMode FacilityPreemptMode a
m,
                     preemptBlockTransfer :: Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer     = Maybe (Maybe Double -> Block (Transact a) ())
transfer,
                     preemptBlockRemoveMode :: Bool
preemptBlockRemoveMode   = FacilityPreemptMode a -> Bool
forall a. FacilityPreemptMode a -> Bool
facilityRemoveMode FacilityPreemptMode a
m
                   }
  where
    transfer :: Maybe (Maybe Double -> Block (Transact a) ())
transfer =
      case FacilityPreemptMode a -> Maybe (FacilityPreemptTransfer a)
forall a.
FacilityPreemptMode a -> Maybe (FacilityPreemptTransfer a)
facilityTransfer FacilityPreemptMode a
m of
        Maybe (FacilityPreemptTransfer a)
Nothing -> Maybe (Maybe Double -> Block (Transact a) ())
forall a. Maybe a
Nothing
        Just FacilityPreemptTransfer a
f  -> (Maybe Double -> Block (Transact a) ())
-> Maybe (Maybe Double -> Block (Transact a) ())
forall a. a -> Maybe a
Just (\Maybe Double
dt -> (Transact a -> Process ()) -> Block (Transact a) ()
forall a b. (a -> Process b) -> Block a b
Block ((Transact a -> Process ()) -> Block (Transact a) ())
-> (Transact a -> Process ()) -> Block (Transact a) ()
forall a b. (a -> b) -> a -> b
$ \Transact a
a -> FacilityPreemptTransfer a
f Transact a
a Maybe Double
dt)

-- | The default Preempt block mode.
defaultPreemptBlockMode :: PreemptBlockMode a
defaultPreemptBlockMode :: PreemptBlockMode a
defaultPreemptBlockMode =
  PreemptBlockMode :: forall a.
Bool
-> Maybe (Maybe Double -> Block (Transact a) ())
-> Bool
-> PreemptBlockMode a
PreemptBlockMode { preemptBlockPriorityMode :: Bool
preemptBlockPriorityMode = Bool
False,
                     preemptBlockTransfer :: Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer     = Maybe (Maybe Double -> Block (Transact a) ())
forall a. Maybe a
Nothing,
                     preemptBlockRemoveMode :: Bool
preemptBlockRemoveMode   = Bool
False
                   }

-- | This is the GPSS construct
--
-- @PREEMPT A,B,C,D,E@
preemptBlock :: Facility a
                -- ^ the facility
                -> PreemptBlockMode a
                -- ^ the Preempt block mode
                -> Block (Transact a) (Transact a)
preemptBlock :: Facility a -> PreemptBlockMode a -> Block (Transact a) (Transact a)
preemptBlock Facility a
r PreemptBlockMode a
m =
  Block :: forall a b. (a -> Process b) -> Block a b
Block { blockProcess :: Transact a -> Process (Transact a)
blockProcess = \Transact a
a -> Facility a -> Transact a -> FacilityPreemptMode a -> Process ()
forall a.
Facility a -> Transact a -> FacilityPreemptMode a -> Process ()
preemptFacility Facility a
r Transact a
a (PreemptBlockMode a -> FacilityPreemptMode a
forall a. PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode PreemptBlockMode a
m) Process () -> Process (Transact a) -> Process (Transact a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Transact a -> Process (Transact a)
forall (m :: * -> *) a. Monad m => a -> m a
return Transact a
a }