A simple stream hotel room allocator...

Hotel.hs

module Hotel where

import Data.List

data Allocs = Allocs {checkouts :: [RoomNo], checkins :: [RoomNo], currentMax :: Int}
 deriving (Eq)
instance Show Allocs where
 show (Allocs xo xi cm) = "A" ++ (show xo) ++ " " ++ (show xi)++" " ++ (show cm) ++ " "

type GuestStay = Int
type RoomNo = Int
type DailyGuests = [ GuestStay ]
type Bookings = [ DailyGuests ]

type RoomUse = (RoomNo,GuestStay)

data Hotel = Hotel { inUse :: [RoomUse], ready :: [RoomUse] , virgin :: [RoomNo] } deriving Eq

instance Show Hotel where
  show h = "<< " ++ ( show $ inUse h ) ++ " " ++ (show $ ready h ) ++ " " ++  (init $ (show (take 3 $ virgin h) )) ++ "...] >>"


tes :: Bookings
tes = [ [3,3], [2,1], [], [4], [2,2], [] ]

emptyH = Hotel [] [] [1..]

nextDay :: Hotel -> Hotel
nextDay (Hotel i r v) = Hotel (map (\(r,s)->(r,s - 1)) i) (map (\(r,s)->(r,s - 1)) r) v

allocs :: Bookings -> [Allocs]
allocs bs = worker bs emptyH
  where
   worker [] (Hotel [] _ _) = []
   worker (b:bs) h = let (hh, aa) = f h b in aa : worker bs hh
   worker [] h = let (hh, aa) = f h [] in aa : worker [] hh

f :: Hotel -> DailyGuests -> (Hotel, Allocs)
f h g = (Hotel i'' r'' v'', Allocs xo xi ((head v'')-1))
  where
    n = length g
    (Hotel i r v) = nextDay h
    i' = [ ru  | ru@(_, stay) <- i, stay > 0 ]
    r' = [ ru  | ru@(_, stay) <- i, stay == 0]
    xo = map fst r'
    freeRooms = r ++ r'
    freeRoomsNos = map fst freeRooms

    r'' = drop n (freeRooms) -- replace by a better room reuse strategy
    xi = take n (freeRoomsNos ++ v)
    v'' = drop (n - (length freeRooms)) v
    i'' = i' ++ zip xi g