-------------------------------------------------------------------------
-- 
--  Haskell: The Craft of Functional Programming, 3e
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
--
--  The top level of the server simulation.
--
-------------------------------------------------------------------------

module TopLevelServe where

import Base     -- for the base types of the system
import QueueState   -- for the queue type
import ServerState  -- for the server type
import RandomGen    -- for the random inputs


-- The top-level simulation is a function from a series of input 
-- messages to a series of output messages, so

doSimulation :: ServerState -> [Inmess] -> [Outmess]

doSimulation :: ServerState -> [Inmess] -> [Outmess]
doSimulation ServerState
servSt (Inmess
im:[Inmess]
messes)
  = [Outmess]
outmesses [Outmess] -> [Outmess] -> [Outmess]
forall a. [a] -> [a] -> [a]
++ ServerState -> [Inmess] -> [Outmess]
doSimulation ServerState
servStNext [Inmess]
messes
    where
    (ServerState
servStNext , [Outmess]
outmesses) = ServerState -> Inmess -> (ServerState, [Outmess])
simulationStep ServerState
servSt Inmess
im

-- How do we generate an input sequence? From RandomGen we have the
-- sequence of times given by randomTimes

simulationInput :: [Inmess] 

simulationInput :: [Inmess]
simulationInput = (Int -> Int -> Inmess) -> [Int] -> [Int] -> [Inmess]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Inmess
Yes [Int
1 .. ] [Int]
randomTimes

-- The output generated by the sample input.

simEx :: [Outmess]

simEx :: [Outmess]
simEx = ServerState -> [Inmess] -> [Outmess]
doSimulation ServerState
serverStart [Inmess]
simulationInput

--  = [Discharge 1 0 2, Discharge 3 0 1, Discharge 6 0 1, 
--     Discharge 2 0 5, Discharge 5 0 3, Discharge 4 0 4,
--     Discharge 7 2 2,...

-- A `finite' input: infinite list with only a finite number of `interesting'
-- inputs.

simulationInput2 :: [Inmess] 

simulationInput2 :: [Inmess]
simulationInput2 = Int -> [Inmess] -> [Inmess]
forall a. Int -> [a] -> [a]
take Int
50 [Inmess]
simulationInput [Inmess] -> [Inmess] -> [Inmess]
forall a. [a] -> [a] -> [a]
++ [Inmess]
noes

noes :: [Inmess]
noes = Inmess
No Inmess -> [Inmess] -> [Inmess]
forall a. a -> [a] -> [a]
: [Inmess]
noes

-- A finite list of outputs, corresponding to the `finite' list of inputs given by
-- simulationInput2

simEx2 :: [Outmess]

simEx2 :: [Outmess]
simEx2 = Int -> [Outmess] -> [Outmess]
forall a. Int -> [a] -> [a]
take Int
50 (ServerState -> [Inmess] -> [Outmess]
doSimulation ServerState
serverStart [Inmess]
simulationInput2)

-- Total waiting time on all the queues

totalWait :: [Outmess] -> Int
totalWait :: [Outmess] -> Int
totalWait = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Outmess] -> [Int]) -> [Outmess] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Outmess -> Int) -> [Outmess] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Outmess -> Int
waitTime
            where
            waitTime :: Outmess -> Int
waitTime (Discharge Int
_ Int
w Int
_) = Int
w

-- Total wait in the second example.

totalWaitEx2 :: Int
totalWaitEx2 = [Outmess] -> Int
totalWait [Outmess]
simEx2