-------------------------------------------------------------------------
-- 
--  Haskell: The Craft of Functional Programming, 3e
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
--
--  The server ADT: its signature is given in comments in the module
--  header.
--
-------------------------------------------------------------------------

module ServerState 

  ( ServerState ,
    addToQueue,     -- Int -> Inmess -> ServerState -> ServerState
    serverStep,     -- ServerState -> ( ServerState , [Outmess] )
    simulationStep, -- ServerState -> Inmess -> ( ServerState , [Outmess] ) 
    serverStart,    -- ServerState
    serverSize,     -- ServerState -> Int
    shortestQueue   -- ServerState -> Int
  ) where

import Base     -- for the base types of the system
import QueueState   -- for the queue type

-- The server consists of a collection of queues, accessed by integers from 0.

newtype ServerState = SS [QueueState] 
                         deriving (ServerState -> ServerState -> Bool
(ServerState -> ServerState -> Bool)
-> (ServerState -> ServerState -> Bool) -> Eq ServerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerState -> ServerState -> Bool
== :: ServerState -> ServerState -> Bool
$c/= :: ServerState -> ServerState -> Bool
/= :: ServerState -> ServerState -> Bool
Eq, Int -> ServerState -> ShowS
[ServerState] -> ShowS
ServerState -> String
(Int -> ServerState -> ShowS)
-> (ServerState -> String)
-> ([ServerState] -> ShowS)
-> Show ServerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerState -> ShowS
showsPrec :: Int -> ServerState -> ShowS
$cshow :: ServerState -> String
show :: ServerState -> String
$cshowList :: [ServerState] -> ShowS
showList :: [ServerState] -> ShowS
Show)

-- Adding an element to one of the queues. It uses the function addMessage from the 
-- QueueState abstract type.

addToQueue :: Int -> Inmess -> ServerState -> ServerState
--  
addToQueue :: Int -> Inmess -> ServerState -> ServerState
addToQueue Int
n Inmess
im (SS [QueueState]
st)
  = [QueueState] -> ServerState
SS (Int -> [QueueState] -> [QueueState]
forall a. Int -> [a] -> [a]
take Int
n [QueueState]
st [QueueState] -> [QueueState] -> [QueueState]
forall a. [a] -> [a] -> [a]
++ [QueueState
newQueueState] [QueueState] -> [QueueState] -> [QueueState]
forall a. [a] -> [a] -> [a]
++ Int -> [QueueState] -> [QueueState]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [QueueState]
st)
    where
    newQueueState :: QueueState
newQueueState = Inmess -> QueueState -> QueueState
addMessage Inmess
im ([QueueState]
st[QueueState] -> Int -> QueueState
forall a. HasCallStack => [a] -> Int -> a
!!Int
n)

-- A step of the server is given by making a step in each of the constituent
-- queues, and concatenating together the output messages they produce.

serverStep :: ServerState -> ( ServerState , [Outmess] )

serverStep :: ServerState -> (ServerState, [Outmess])
serverStep (SS [])
  = ([QueueState] -> ServerState
SS [],[])
serverStep (SS (QueueState
q:[QueueState]
qs)) 
  =  ([QueueState] -> ServerState
SS (QueueState
q'QueueState -> [QueueState] -> [QueueState]
forall a. a -> [a] -> [a]
:[QueueState]
qs') , [Outmess]
mess[Outmess] -> [Outmess] -> [Outmess]
forall a. [a] -> [a] -> [a]
++[Outmess]
messes)
    where
    (QueueState
q' , [Outmess]
mess)       = QueueState -> (QueueState, [Outmess])
queueStep  QueueState
q
    (SS [QueueState]
qs' , [Outmess]
messes) = ServerState -> (ServerState, [Outmess])
serverStep ([QueueState] -> ServerState
SS [QueueState]
qs)

-- In making a simulation step, we perform a server step, and then add the
-- incoming message, if it indicates an arrival, to the shortest queue. 

simulationStep  
  :: ServerState -> Inmess -> ( ServerState , [Outmess] )

simulationStep :: ServerState -> Inmess -> (ServerState, [Outmess])
simulationStep ServerState
servSt Inmess
im 
  = (Inmess -> ServerState -> ServerState
addNewObject Inmess
im ServerState
servSt1 , [Outmess]
outmess)
    where
    (ServerState
servSt1 , [Outmess]
outmess) = ServerState -> (ServerState, [Outmess])
serverStep ServerState
servSt

-- Adding the message to the shortest queue is done by addNewObject, which
-- is not in the signature. The reason for this is that it can be defined using
-- the operations addToQueue and shortestQueue.

addNewObject :: Inmess -> ServerState -> ServerState

addNewObject :: Inmess -> ServerState -> ServerState
addNewObject Inmess
No ServerState
servSt = ServerState
servSt

addNewObject (Yes Int
arr Int
wait) ServerState
servSt
  = Int -> Inmess -> ServerState -> ServerState
addToQueue (ServerState -> Int
shortestQueue ServerState
servSt) (Int -> Int -> Inmess
Yes Int
arr Int
wait) ServerState
servSt

-- The start state of the server.

serverStart :: ServerState
serverStart :: ServerState
serverStart = [QueueState] -> ServerState
SS (Int -> QueueState -> [QueueState]
forall a. Int -> a -> [a]
replicate Int
numQueues QueueState
queueStart) 

-- The size of the server.

serverSize :: ServerState -> Int
serverSize :: ServerState -> Int
serverSize (SS [QueueState]
xs) = [QueueState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [QueueState]
xs

-- The shortest queue in the server.

shortestQueue :: ServerState -> Int
shortestQueue :: ServerState -> Int
shortestQueue (SS [QueueState
q]) = Int
0
shortestQueue (SS (QueueState
q:[QueueState]
qs)) 
  | (QueueState -> Int
queueLength ([QueueState]
qs[QueueState] -> Int -> QueueState
forall a. HasCallStack => [a] -> Int -> a
!!Int
short) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= QueueState -> Int
queueLength QueueState
q)   = Int
shortInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
  | Bool
otherwise                                    = Int
0
      where
      short :: Int
short = ServerState -> Int
shortestQueue ([QueueState] -> ServerState
SS [QueueState]
qs)

-- The number of queues in the simulation

numQueues :: Int
numQueues :: Int
numQueues = Int
4