http://try.purescript.org/?session=4ce8809e-61ce-ca30-d756-f752fb9ec21e&backend=core&gist=d85d48b7f077f4a02ae775809b5162b8

DystopianPhoneSystem.purs

-- | A dystopian phone system that punishes users who
-- | call the business when it is not open. Calls outside of
-- | business hours are put into a call queue that will never
-- | be answered.

module Main where

import Prelude

import Control.Monad.Eff (Eff)
import Data.Foldable (fold)
import TryPureScript (Doc, DOM, p, text, list, indent, link, render, code)
import Data.Map (Map, insert, values)
import Control.Monad.ST (ST, runST, newSTRef, modifySTRef)
import Data.Monoid (mempty)
import Data.Generic (class Generic, gShow)
import Data.Newtype (unwrap, class Newtype)

newtype User = User { phoneNumber :: String }
instance showUser :: Show User where show (User {phoneNumber : n }) = show n
derive instance newtypeUser :: Newtype User _

newtype TimeStamp = TimeStamp Number
derive instance eqTimeStamp :: Eq TimeStamp
derive instance ordTimeStamp :: Ord TimeStamp
instance showTimeStamp :: Show TimeStamp where show (TimeStamp n) = show n

type CallQueue = Map TimeStamp User

type Business = {
  openTime :: TimeStamp,
  closeTime :: TimeStamp,
  callQueue :: CallQueue,
  punishmentQueue :: CallQueue
}

main :: Eff (dom :: DOM) Unit
main = do
  let callTime = TimeStamp 7.99
  let openTime = TimeStamp 8.0
  let closeTime = TimeStamp 17.0
  
  let user = User { phoneNumber : "(970) 555-2351" }
  let business = {
        openTime : openTime,
        closeTime : closeTime,
        callQueue : mempty,
        punishmentQueue : mempty
      }
  
  render $ fold (
    [ p $ text $ (unwrap user).phoneNumber <> " called " <> (callStatus callTime business) <> "."
    , p $ text "Phone System:"
    ] <>
    (showBusiness $ callBusiness business user callTime)
  )

callStatus :: TimeStamp -> Business -> String
callStatus time { openTime : openTime, closeTime : closeTime } =
  if (time < openTime || time > closeTime)
    then "outside business hours"
    else "within business hours"

showBusiness :: Business -> Array Doc
showBusiness b = [
    p (text $ "CallQueue: " <> (show $ values b.callQueue)),
    p (text $ "PunishmentQueue: " <> (show $ values b.punishmentQueue))
  ]
                  

callBusiness :: Business -> User -> TimeStamp -> Business
callBusiness business user time =
  if isOpen business time
    then addToCallQueue business time user
    else addToPunishmentQueue business time user

addToCallQueue :: forall e
   . { callQueue :: CallQueue | e}
  -> TimeStamp 
  -> User  
  -> { callQueue :: CallQueue | e}
addToCallQueue r@{ callQueue : pq } t u =
  (r { callQueue = (addToQueue t u pq) })

addToQueue :: TimeStamp -> User -> CallQueue -> CallQueue
addToQueue = insert

addToPunishmentQueue :: forall e
   . { punishmentQueue :: CallQueue | e}
  -> TimeStamp 
  -> User  
  -> { punishmentQueue :: CallQueue | e}
addToPunishmentQueue r@{ punishmentQueue : pq } t u =
  (r { punishmentQueue = (addToQueue t u pq) })

isOpen :: forall e
   . { openTime :: TimeStamp, closeTime :: TimeStamp | e }
  -> TimeStamp
  -> Boolean
isOpen { openTime : ot, closeTime : ct } time = time >= ot && time <= ct