aivika-gpss-0.3: examples/Example7-26Distributed.hs

{-
        GENERATE 2000,500,,,1
        GATE NI PROF,Busy
        PREEMPT PROF,PR,Add,5
        ADVANCE (Exponential(1,0,200))
        RETURN PROF
Busy    TERMINATE

        GENERATE 2000,500
        QUEUE LINE
        SEIZE PROF
        DEPART LINE
        ADVANCE (Exponential(1,0,1000))
LetGo   RELEASE PROF
        TERMINATE

Add     ASSIGN 5+,300
        ADVANCE P5
        TRANSFER ,LetGo

        GENERATE 10000000
        TERMINATE 1

        START 1
 -}

import Prelude hiding (id, (.))

import Control.Category
import Control.Monad.Trans
import qualified Control.Distributed.Process as DP
import Control.Distributed.Process.Node (initRemoteTable)
import Control.Distributed.Process.Backend.SimpleLocalnet

import Data.Maybe

import Simulation.Aivika.Trans
import Simulation.Aivika.Trans.GPSS
import qualified Simulation.Aivika.Trans.GPSS.Queue as Q

import Simulation.Aivika.Distributed

type DES = DIO

specs = Specs { spcStartTime = 0.0,
                spcStopTime = 10000000.0,
                spcDT = 1.0,
                spcMethod = RungeKutta4,
                spcGeneratorType = SimpleGenerator }
        
model :: Simulation DES ()
model =
  do line <- runEventInStartTime Q.newQueue
     prof <- runEventInStartTime newFacility

     let phoneCallStream = randomUniformStream (2000 - 500) (2000 + 500)
         studentStream   = randomUniformStream (2000 - 500) (2000 + 500)

     let phoneCalls     = streamGeneratorBlock phoneCallStream 1
         phoneCallChain =
           Block (\a ->
                   do f <- liftEvent (facilityInterrupted prof)
                      if f
                        then blockProcess (transferBlock busy) a
                        else return a) >>>
           preemptBlock prof
           (PreemptBlockMode { preemptBlockPriorityMode = True,
                               preemptBlockTransfer     = Just add,
                               -- preemptBlockTransfer     = Nothing,
                               preemptBlockRemoveMode   = False }) >>>
           advanceBlock (randomExponentialProcess_ 200) >>>
           returnBlock prof >>>
           busy
         busy           = terminateBlock
         
         students       = streamGeneratorBlock studentStream 0
         studentChain   =
           queueBlock line 1 >>>
           seizeBlock prof >>>
           departBlock line 1 >>>
           advanceBlock (randomExponentialProcess_ 1000) >>>
           letGo
         letGo          =
           releaseBlock prof >>>
           terminateBlock
         add dt0        =
           let dt = maybe 0 id dt0
           in advanceBlock (holdProcess (dt + 300)) >>>
              transferBlock letGo

     runProcessInStartTime $
       runGeneratorBlock phoneCalls phoneCallChain 

     runProcessInStartTime $
       runGeneratorBlock students studentChain 
  
     let rs =
           results
           [resultSource "line" "Line" line,
            resultSource "prof" "Prof" prof]

     printResultsInStopTime printResultSourceInEnglish rs
  
runModel :: DP.ProcessId -> DP.Process ()
runModel timeServerId =
  do DP.say "Started simulating..."
     let ps = defaultDIOParams { dioLoggingPriority = NOTICE }
         m =
           do registerDIO
              a <- runSimulation model specs
              terminateDIO
              return a
     (modelId, modelProcess) <- runDIO m ps timeServerId
     modelProcess

master = \backend nodes ->
  do liftIO . putStrLn $ "Slaves: " ++ show nodes
     let timeServerParams = defaultTimeServerParams { tsLoggingPriority = NOTICE }
     timeServerId  <- DP.spawnLocal $ timeServer 1 timeServerParams
     runModel timeServerId

main :: IO ()
main = do
  backend <- initializeBackend "localhost" "8080" rtable
  startMaster backend (master backend)
    where
      rtable :: DP.RemoteTable
      -- rtable = __remoteTable initRemoteTable
      rtable = initRemoteTable