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

  ( QueueState ,
    addMessage,      -- Inmess -> QueueState -> QueueState
    queueStep,       -- QueueState -> ( QueueState , [Outmess] )
    queueStart,      -- QueueState
    queueLength,     -- QueueState -> Int
    queueEmpty       -- QueueState -> Bool
    ) where

import Base     -- for the base types of the system

type Time = Int

-- The implementation of the QueueState, where the first field gives the 
-- current time, the second the service time so far for the item currently 
-- being processed,

data QueueState = QS Time Service [Inmess]
                  deriving (QueueState -> QueueState -> Bool
(QueueState -> QueueState -> Bool)
-> (QueueState -> QueueState -> Bool) -> Eq QueueState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueueState -> QueueState -> Bool
== :: QueueState -> QueueState -> Bool
$c/= :: QueueState -> QueueState -> Bool
/= :: QueueState -> QueueState -> Bool
Eq, Service -> QueueState -> ShowS
[QueueState] -> ShowS
QueueState -> String
(Service -> QueueState -> ShowS)
-> (QueueState -> String)
-> ([QueueState] -> ShowS)
-> Show QueueState
forall a.
(Service -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Service -> QueueState -> ShowS
showsPrec :: Service -> QueueState -> ShowS
$cshow :: QueueState -> String
show :: QueueState -> String
$cshowList :: [QueueState] -> ShowS
showList :: [QueueState] -> ShowS
Show)

-- To add a message, it is put at the end of the list of messages.

addMessage  :: Inmess -> QueueState -> QueueState

addMessage :: Inmess -> QueueState -> QueueState
addMessage Inmess
im (QS Service
time Service
serv [Inmess]
ml) 
  | Inmess -> Bool
isYes Inmess
im        = Service -> Service -> [Inmess] -> QueueState
QS Service
time Service
serv ([Inmess]
ml[Inmess] -> [Inmess] -> [Inmess]
forall a. [a] -> [a] -> [a]
++[Inmess
im])
  | Bool
otherwise       = Service -> Service -> [Inmess] -> QueueState
QS Service
time Service
serv [Inmess]
ml
    where
    isYes :: Inmess -> Bool
isYes (Yes Service
_ Service
_)     = Bool
True
    isYes Inmess
_             = Bool
False

-- A single step in the queue simulation.

queueStep   :: QueueState -> ( QueueState , [Outmess] )

queueStep :: QueueState -> (QueueState, [Outmess])
queueStep (QS Service
time  Service
servSoFar (Yes Service
arr Service
serv : [Inmess]
inRest))
  | Service
servSoFar Service -> Service -> Bool
forall a. Ord a => a -> a -> Bool
< Service
serv
    = (Service -> Service -> [Inmess] -> QueueState
QS (Service
timeService -> Service -> Service
forall a. Num a => a -> a -> a
+Service
1) (Service
servSoFarService -> Service -> Service
forall a. Num a => a -> a -> a
+Service
1) (Service -> Service -> Inmess
Yes Service
arr Service
serv Inmess -> [Inmess] -> [Inmess]
forall a. a -> [a] -> [a]
: [Inmess]
inRest) , [])
  | Bool
otherwise
    = (Service -> Service -> [Inmess] -> QueueState
QS (Service
timeService -> Service -> Service
forall a. Num a => a -> a -> a
+Service
1) Service
0 [Inmess]
inRest , [Service -> Service -> Service -> Outmess
Discharge Service
arr (Service
timeService -> Service -> Service
forall a. Num a => a -> a -> a
-Service
servService -> Service -> Service
forall a. Num a => a -> a -> a
-Service
arr) Service
serv])
--  
queueStep (QS Service
time Service
serv []) = (Service -> Service -> [Inmess] -> QueueState
QS (Service
timeService -> Service -> Service
forall a. Num a => a -> a -> a
+Service
1) Service
serv [] , [])

-- The starting state

queueStart  :: QueueState
queueStart :: QueueState
queueStart  =  Service -> Service -> [Inmess] -> QueueState
QS Service
0 Service
0 [] 

-- The length of the queue

queueLength :: QueueState -> Int
queueLength :: QueueState -> Service
queueLength (QS Service
_ Service
_ [Inmess]
q) = [Inmess] -> Service
forall a. [a] -> Service
forall (t :: * -> *) a. Foldable t => t a -> Service
length [Inmess]
q

-- Is the queue empty?

queueEmpty  :: QueueState -> Bool
queueEmpty :: QueueState -> Bool
queueEmpty (QS Service
_ Service
_ [Inmess]
q)  = ([Inmess]
q[Inmess] -> [Inmess] -> Bool
forall a. Eq a => a -> a -> Bool
==[])