module RoomsAndClients(

    RoomIndex(),

    ClientIndex(),

    MRoomsAndClients(),

    IRoomsAndClients(),

    newRoomsAndClients,

    addRoom,

    addClient,

    removeRoom,

    removeClient,

    modifyRoom,

    modifyClient,

    lobbyId,

    moveClientToLobby,

    moveClientToRoom,

    clientRoom,

    clientRoomM,

    client,

    room,

    client'sM,

    clientsM,

    roomClientsM,

    withRoomsAndClients,

    allRooms,

    allClients,

    clientRoom,

    showRooms,

    roomClients

    ) where

import Store

import Control.Monad

data Room r = Room {

    roomClients' :: [ClientIndex],

    room' :: r

    }

data Client c = Client {

    clientRoom' :: RoomIndex,

    client' :: c

    }

newtype RoomIndex = RoomIndex ElemIndex

    deriving (Eq)

newtype ClientIndex = ClientIndex ElemIndex

    deriving (Eq, Show, Read, Ord)

instance Show RoomIndex where

    show (RoomIndex i) = 'r' : show i

unRoomIndex :: RoomIndex -> ElemIndex

unRoomIndex (RoomIndex r) = r

unClientIndex :: ClientIndex -> ElemIndex

unClientIndex (ClientIndex c) = c

newtype MRoomsAndClients r c = MRoomsAndClients (MStore (Room r), MStore (Client c))

newtype IRoomsAndClients r c = IRoomsAndClients (IStore (Room r), IStore (Client c))

lobbyId :: RoomIndex

lobbyId = RoomIndex firstIndex

newRoomsAndClients :: r -> IO (MRoomsAndClients r c)

newRoomsAndClients r = do

    rooms <- newStore

    clients <- newStore

    let rnc = MRoomsAndClients (rooms, clients)

    ri <- addRoom rnc r

    when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index"

    return rnc

roomAddClient :: ClientIndex -> Room r -> Room r

roomAddClient cl room = room{roomClients' = cl : roomClients' room}

roomRemoveClient :: ClientIndex -> Room r -> Room r

roomRemoveClient cl room = room{roomClients' = filter (/= cl) $ roomClients' room}

addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex

addRoom (MRoomsAndClients (rooms, _)) room = do

    i <- addElem rooms (Room  [] room)

    return $ RoomIndex i

addClient :: MRoomsAndClients r c -> c -> IO ClientIndex

addClient (MRoomsAndClients (rooms, clients)) client = do

    i <- addElem clients (Client lobbyId client)

    modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId)

    return $ ClientIndex i

removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO ()

removeRoom rnc@(MRoomsAndClients (rooms, _)) room@(RoomIndex ri) 

    | room == lobbyId = error "Cannot delete lobby"

    | otherwise = do

        clIds <- liftM roomClients' $ readElem rooms ri

        forM_ clIds (moveClientToLobby rnc)

        removeElem rooms ri

removeClient :: MRoomsAndClients r c -> ClientIndex -> IO ()

removeClient (MRoomsAndClients (rooms, clients)) cl@(ClientIndex ci) = do

    RoomIndex ri <- liftM clientRoom' $ readElem clients ci

    modifyElem rooms (roomRemoveClient cl) ri

    removeElem clients ci

modifyRoom :: MRoomsAndClients r c -> (r -> r) -> RoomIndex -> IO ()

modifyRoom (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = modifyElem rooms (\r -> r{room' = f $ room' r}) ri

modifyClient :: MRoomsAndClients r c -> (c -> c) -> ClientIndex -> IO ()

modifyClient (MRoomsAndClients (_, clients)) f (ClientIndex ci) = modifyElem clients (\c -> c{client' = f $ client' c}) ci

moveClientInRooms :: MRoomsAndClients r c -> RoomIndex -> RoomIndex -> ClientIndex -> IO ()

moveClientInRooms (MRoomsAndClients (rooms, clients)) (RoomIndex riFrom) rt@(RoomIndex riTo) cl@(ClientIndex ci) = do

    modifyElem rooms (roomRemoveClient cl) riFrom

    modifyElem rooms (roomAddClient cl) riTo

    modifyElem clients (\c -> c{clientRoom' = rt}) ci

moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO ()

moveClientToLobby rnc ci = do

    room <- clientRoomM rnc ci

    moveClientInRooms rnc room lobbyId ci

moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO ()

moveClientToRoom rnc ri ci = moveClientInRooms rnc lobbyId ri ci

clientRoomM :: MRoomsAndClients r c -> ClientIndex -> IO RoomIndex

clientRoomM (MRoomsAndClients (_, clients)) (ClientIndex ci) = liftM clientRoom' (clients `readElem` ci)

client'sM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a

client'sM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)

clientsM :: MRoomsAndClients r c -> IO [c]

clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)

roomClientsM :: MRoomsAndClients r c -> RoomIndex -> IO [c]

roomClientsM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) >>= mapM (\(ClientIndex ci) -> liftM client' $ readElem clients ci)

withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a

withRoomsAndClients (MRoomsAndClients (rooms, clients)) f =

    withIStore2 rooms clients (\r c -> f $ IRoomsAndClients (r, c))

----------------------------------------

----------- IRoomsAndClients -----------

showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String

showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc)

    where

    showRoom r = unlines $ ((show r) ++ ": " ++ (show $ room' $ rooms ! (unRoomIndex r))) : (map showClient (roomClients' $ rooms ! (unRoomIndex r)))

    showClient c = "    " ++ (show c) ++ ": " ++ (show $ client' $ clients ! (unClientIndex c))

allRooms :: IRoomsAndClients r c -> [RoomIndex]

allRooms (IRoomsAndClients (rooms, _)) = map RoomIndex $ indices rooms

allClients :: IRoomsAndClients r c -> [ClientIndex]

allClients (IRoomsAndClients (_, clients)) = map ClientIndex $ indices clients

clientRoom :: IRoomsAndClients r c -> ClientIndex -> RoomIndex

clientRoom (IRoomsAndClients (_, clients)) (ClientIndex ci) = clientRoom' (clients ! ci)

client :: IRoomsAndClients r c -> ClientIndex -> c

client (IRoomsAndClients (_, clients)) (ClientIndex ci) = client' (clients ! ci)

room :: IRoomsAndClients r c -> RoomIndex -> r

room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri)

roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex]

roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' $ (rooms ! ri)