-- |
-- 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 { forall a. PreemptBlockMode a -> Bool
preemptBlockPriorityMode :: Bool,
                     -- ^ the Priority mode; otherwise, the Interrupt mode
                     forall a.
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
                     forall a. PreemptBlockMode a -> Bool
preemptBlockRemoveMode :: Bool
                     -- ^ the Remove mode
                   }

-- | Convert 'PreemptBlockMode' to 'FacilityPreemptMode'.
toFacilityPreemptMode :: PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode :: forall a. PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode PreemptBlockMode a
m =
  FacilityPreemptMode { facilityPriorityMode :: Bool
facilityPriorityMode = forall a. PreemptBlockMode a -> Bool
preemptBlockPriorityMode PreemptBlockMode a
m,
                        facilityTransfer :: Maybe (FacilityPreemptTransfer a)
facilityTransfer     = Maybe (FacilityPreemptTransfer a)
transfer,
                        facilityRemoveMode :: Bool
facilityRemoveMode   = forall a. PreemptBlockMode a -> Bool
preemptBlockRemoveMode PreemptBlockMode a
m
                      }
  where
    transfer :: Maybe (FacilityPreemptTransfer a)
transfer =
      case forall a.
PreemptBlockMode a -> Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer PreemptBlockMode a
m of
        Maybe (Maybe Double -> Block (Transact a) ())
Nothing -> forall a. Maybe a
Nothing
        Just Maybe Double -> Block (Transact a) ()
f  -> forall a. a -> Maybe a
Just (\Transact a
a Maybe Double
dt -> 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 :: forall a. FacilityPreemptMode a -> PreemptBlockMode a
fromFacilityPreemptMode FacilityPreemptMode a
m =
  PreemptBlockMode { preemptBlockPriorityMode :: Bool
preemptBlockPriorityMode = 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   = forall a. FacilityPreemptMode a -> Bool
facilityRemoveMode FacilityPreemptMode a
m
                   }
  where
    transfer :: Maybe (Maybe Double -> Block (Transact a) ())
transfer =
      case forall a.
FacilityPreemptMode a -> Maybe (FacilityPreemptTransfer a)
facilityTransfer FacilityPreemptMode a
m of
        Maybe (FacilityPreemptTransfer a)
Nothing -> forall a. Maybe a
Nothing
        Just FacilityPreemptTransfer a
f  -> forall a. a -> Maybe a
Just (\Maybe Double
dt -> forall a b. (a -> Process b) -> Block a b
Block 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 :: forall a. PreemptBlockMode a
defaultPreemptBlockMode =
  PreemptBlockMode { preemptBlockPriorityMode :: Bool
preemptBlockPriorityMode = Bool
False,
                     preemptBlockTransfer :: Maybe (Maybe Double -> Block (Transact a) ())
preemptBlockTransfer     = 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 :: forall a.
Facility a -> PreemptBlockMode a -> Block (Transact a) (Transact a)
preemptBlock Facility a
r PreemptBlockMode a
m =
  Block { blockProcess :: Transact a -> Process (Transact a)
blockProcess = \Transact a
a -> forall a.
Facility a -> Transact a -> FacilityPreemptMode a -> Process ()
preemptFacility Facility a
r Transact a
a (forall a. PreemptBlockMode a -> FacilityPreemptMode a
toFacilityPreemptMode PreemptBlockMode a
m) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Transact a
a }