-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.GPSS.Block.Preempt
       (preemptBlock,
        PreemptBlockMode(..),
        defaultPreemptBlockMode,
        toFacilityPreemptMode,
        fromFacilityPreemptMode) where

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

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

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

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

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

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