{--# LANGUAGE TemplateHaskell #--}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- It corresponds to model MachRep2 described in document 
-- Introduction to Discrete-Event Simulation and the SimPy Language
-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
-- SimPy is available on [http://simpy.sourceforge.net/].
--   
-- The model description is as follows.
--   
-- Two machines, but sometimes break down. Up time is exponentially 
-- distributed with mean 1.0, and repair time is exponentially distributed 
-- with mean 0.5. In this example, there is only one repairperson, so 
-- the two machines cannot be repaired simultaneously if they are down 
-- at the same time.
--
-- In addition to finding the long-run proportion of up time as in
-- model MachRep1, let’s also find the long-run proportion of the time 
-- that a given machine does not have immediate access to the repairperson 
-- when the machine breaks down. Output values should be about 0.6 and 0.67. 

import Data.Typeable
import Data.Binary

import System.Random

import GHC.Generics

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

import Simulation.Aivika.Trans
import Simulation.Aivika.Distributed

meanUpTime = 1.0
meanRepairTime = 0.5

specs = Specs { spcStartTime = 0.0,
                spcStopTime = 1000.0,
                spcDT = 1.0,
                spcMethod = RungeKutta4,
                spcGeneratorType = SimpleGenerator }

-- | The time shift when replying the messages.
delta = 0.01

-- | The initial seeds.
seeds = [456, 789]

-- | Create a new random generator by the specified seed.
newRandomRef :: Int -> Simulation DIO (Ref DIO StdGen)
newRandomRef = newRef . mkStdGen

-- | Generate a random number with the specified mean
randomRefExponential :: RandomGen g => Ref DIO g -> Double -> Event DIO Double
randomRefExponential r mu =
  do g <- readRef r
     let (x, g') = random g
     writeRef r g'
     return (- log x * mu)

data TotalUpTimeChange = TotalUpTimeChange (DP.ProcessId, Double) deriving (Eq, Ord, Show, Typeable, Generic)
data TotalUpTimeChangeResp = TotalUpTimeChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)

data NRepChange = NRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)
data NRepChangeResp = NRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)

data NImmedRepChange = NImmedRepChange (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)
data NImmedRepChangeResp = NImmedRepChangeResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)

data RepairPersonCount = RepairPersonCount DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)
data RepairPersonCountResp = RepairPersonCountResp (DP.ProcessId, Int) deriving (Eq, Ord, Show, Typeable, Generic)

data RequestRepairPerson = RequestRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)
data RequestRepairPersonResp = RequestRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)

data ReleaseRepairPerson = ReleaseRepairPerson DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)
data ReleaseRepairPersonResp = ReleaseRepairPersonResp DP.ProcessId deriving (Eq, Ord, Show, Typeable, Generic)

instance Binary TotalUpTimeChange
instance Binary TotalUpTimeChangeResp

instance Binary NRepChange
instance Binary NRepChangeResp

instance Binary NImmedRepChange
instance Binary NImmedRepChangeResp

instance Binary RepairPersonCount
instance Binary RepairPersonCountResp

instance Binary RequestRepairPerson
instance Binary RequestRepairPersonResp

instance Binary ReleaseRepairPerson
instance Binary ReleaseRepairPersonResp

-- | A sub-model.
slaveModel :: DP.ProcessId -> Int -> Simulation DIO ()
slaveModel masterId i =
  do inboxId <- liftComp messageInboxId
     g <- newRandomRef $ seeds !! (i - 1)

     let machine =
           do t <- liftDynamics time
              upTime <- randomRefExponential g meanUpTime
              enqueueMessage masterId (t + delta + upTime) (TotalUpTimeChange (inboxId, upTime))
              enqueueMessage masterId (t + delta + upTime) (NRepChange (inboxId, 1))
              enqueueMessage masterId (t + delta + upTime) (RepairPersonCount inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(RepairPersonCountResp (senderId, n)) ->
       do t <- liftDynamics time
          when (n == 1) $
            enqueueMessage masterId (t + delta) (NImmedRepChange (inboxId, 1))
          enqueueMessage masterId (t + delta) (RequestRepairPerson inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(RequestRepairPersonResp senderId) ->
       do t <- liftDynamics time
          repairTime <- randomRefExponential g meanRepairTime
          enqueueMessage masterId (t + delta + repairTime) (ReleaseRepairPerson inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(ReleaseRepairPersonResp senderId) ->
       machine
  
     runEventInStartTime machine

     runEventInStartTime $
       enqueueEventIOWithStopTime $
       liftIO $
       putStrLn "The sub-model finished"

     runEventInStopTime $
       return ()

-- | The main model.       
masterModel :: Int -> Simulation DIO (Double, Double)
masterModel count =
  do totalUpTime <- newRef 0.0
     nRep <- newRef 0
     nImmedRep <- newRef 0

     let maxRepairPersonCount = 1
     repairPerson <- newFCFSResource maxRepairPersonCount

     inboxId <- liftComp messageInboxId

     runEventInStartTime $
       handleSignal messageReceived $ \(TotalUpTimeChange (senderId, x)) ->
       do modifyRef totalUpTime (+ x)
          t <- liftDynamics time
          enqueueMessage senderId (t + delta) (TotalUpTimeChangeResp inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(NRepChange (senderId, x)) ->
       do modifyRef nRep (+ x)
          t <- liftDynamics time
          enqueueMessage senderId (t + delta) (NRepChangeResp inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(NImmedRepChange (senderId, x)) ->
       do modifyRef nImmedRep (+ x)
          t <- liftDynamics time
          enqueueMessage senderId (t + delta) (NImmedRepChangeResp inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(RepairPersonCount senderId) ->
       do n <- resourceCount repairPerson
          t <- liftDynamics time
          enqueueMessage senderId (t + delta) (RepairPersonCountResp (inboxId, n))

     runEventInStartTime $
       handleSignal messageReceived $ \(RequestRepairPerson senderId) ->
       runProcess $
       do requestResource repairPerson
          t <- liftDynamics time
          liftEvent $
            enqueueMessage senderId (t + delta) (RequestRepairPersonResp inboxId)

     runEventInStartTime $
       handleSignal messageReceived $ \(ReleaseRepairPerson senderId) ->
       do t <- liftDynamics time
          releaseResourceWithinEvent repairPerson
          enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId)
          
     let upTimeProp =
           do x <- readRef totalUpTime
              y <- liftDynamics time
              return $ x / (fromIntegral count * y)

         immedProp =
           do n <- readRef nRep
              nImmed <- readRef nImmedRep
              return $
                fromIntegral nImmed /
                fromIntegral n

     runEventInStopTime $
       do x <- upTimeProp
          y <- immedProp
          return (x, y)

runSlaveModel :: (DP.ProcessId, DP.ProcessId, Int) -> DP.Process (DP.ProcessId, DP.Process ())
runSlaveModel (timeServerId, masterId, i) =
  runDIO m ps timeServerId
  where
    ps = defaultDIOParams { dioLoggingPriority = WARNING }
    m  = do registerDIO
            runSimulation (slaveModel masterId i) specs
            unregisterDIO

-- remotable ['runSlaveModel, 'timeServer]

runMasterModel :: DP.ProcessId -> Int -> DP.Process (DP.ProcessId, DP.Process (Double, Double))
runMasterModel timeServerId n =
  runDIO m ps timeServerId
  where
    ps = defaultDIOParams { dioLoggingPriority = WARNING }
    m  = do registerDIO
            a <- runSimulation (masterModel n) specs
            terminateDIO
            return a

master = \backend nodes ->
  do liftIO . putStrLn $ "Slaves: " ++ show nodes
     let n = length seeds
         timeServerParams = defaultTimeServerParams { tsLoggingPriority = DEBUG }
     timeServerId <- DP.spawnLocal $ timeServer 3 timeServerParams
     (masterId, masterProcess) <- runMasterModel timeServerId n
     forM_ [1..n] $ \i ->
       do (slaveId, slaveProcess) <- runSlaveModel (timeServerId, masterId, i)
          DP.spawnLocal slaveProcess
     a <- masterProcess
     DP.say $
       "The result is " ++ show a
  
main :: IO ()
main = do
  backend <- initializeBackend "localhost" "8080" rtable
  startMaster backend (master backend)
    where
      rtable :: DP.RemoteTable
      -- rtable = __remoteTable initRemoteTable
      rtable = initRemoteTable