module Actions where

import Control.Concurrent.STM

import Control.Concurrent.Chan

import Data.IntMap

import qualified Data.IntSet as IntSet

import Monad

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

import CoreTypes

data Action =

	AnswerThisClient [String]

	| AnswerAll [String]

	| AnswerAllOthers [String]

	| AnswerThisRoom [String]

	| AnswerOthersInRoom [String]

	| AnswerLobby [String]

	| RoomAddThisClient Int -- roomID

	| RoomRemoveThisClient

	| RemoveRoom

	| ProtocolError String

	| Warning String

	| ByeClient String

	| ModifyClient (ClientInfo -> ClientInfo)

	| ModifyRoom (RoomInfo -> RoomInfo)

	| AddRoom String String

	| Dump

type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]

processAction :: (Int, ServerInfo, Clients, Rooms) -> Action -> IO (Int, ServerInfo, Clients, Rooms)

processAction (clID, serverInfo, clients, rooms) (AnswerThisClient msg) = do

	writeChan (sendChan $ clients ! clID) msg

	return (clID, serverInfo, clients, rooms)

processAction (clID, serverInfo, clients, rooms) (AnswerAll msg) = do

	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) (keys clients)

	return (clID, serverInfo, clients, rooms)

processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do

	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ Prelude.filter (/= clID) (keys clients)

	return (clID, serverInfo, clients, rooms)

processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do

	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients

	return (clID, serverInfo, clients, rooms)

	where

		roomClients = IntSet.elems $ playersIDs room

		room = rooms ! rID

		rID = roomID client

		client = clients ! clID

processAction (clID, serverInfo, clients, rooms) (AnswerOthersInRoom msg) = do

	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ Prelude.filter (/= clID) roomClients

	return (clID, serverInfo, clients, rooms)

	where

		roomClients = IntSet.elems $ playersIDs room

		room = rooms ! rID

		rID = roomID client

		client = clients ! clID

processAction (clID, serverInfo, clients, rooms) (AnswerLobby msg) = do

	mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients

	return (clID, serverInfo, clients, rooms)

	where

		roomClients = IntSet.elems $ playersIDs room

		room = rooms ! 0

processAction (clID, serverInfo, clients, rooms) (ProtocolError msg) = do

	writeChan (sendChan $ clients ! clID) ["ERROR", msg]

	return (clID, serverInfo, clients, rooms)

processAction (clID, serverInfo, clients, rooms) (Warning msg) = do

	writeChan (sendChan $ clients ! clID) ["WARNING", msg]

	return (clID, serverInfo, clients, rooms)

processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do

	mapM_ (processAction (clID, serverInfo, clients, rooms)) $ answerOthersQuit ++ answerInformRoom

	writeChan (sendChan $ clients ! clID) ["BYE"]

	return (

			0,

			serverInfo,

			delete clID clients,

			adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r), playersIn = (playersIn r) - 1}) rID rooms

			)

	where

		client = clients ! clID

		rID = roomID client

		clientNick = nick client

		answerInformRoom =

			if roomID client /= 0 then

				if not $ Prelude.null msg then

					[AnswerThisRoom ["LEFT", clientNick, msg]]

				else

					[AnswerThisRoom ["LEFT", clientNick]]

			else

				[]

		answerOthersQuit =

			if not $ Prelude.null clientNick then

				if not $ Prelude.null msg then

					[AnswerAll ["LOBBY:LEFT", clientNick, msg]]

				else

					[AnswerAll ["LOBBY:LEFT", clientNick]]

			else

				[]

processAction (clID, serverInfo, clients, rooms) (ModifyClient func) = do

	return (clID, serverInfo, adjust func clID clients, rooms)

processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) = do

	return (clID, serverInfo, clients, adjust func rID rooms)

	where

		rID = roomID $ clients ! clID

processAction (clID, serverInfo, clients, rooms) (RoomAddThisClient rID) = do

	processAction (

		clID,

		serverInfo,

		adjust (\cl -> cl{roomID = rID}) clID clients,

		adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $

			adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms

		) joinMsg

	where

		client = clients ! clID

		joinMsg = if rID == 0 then

				AnswerAllOthers ["LOBBY:JOINED", nick client]

			else

				AnswerThisRoom ["JOINED", nick client]

processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient) = do

	when (rID /= 0) $ (processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["LEFT", nick client, "part"]) >> return ()

	return (

		clID,

		serverInfo,

		adjust (\cl -> cl{roomID = 0}) clID clients,

		adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r), playersIn = (playersIn r) - 1}) rID $

			adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r)}) 0 rooms

		)

	where

		rID = roomID client

		client = clients ! clID

processAction (clID, serverInfo, clients, rooms) (AddRoom roomName roomPassword) = do

	let newServerInfo = serverInfo {nextRoomID = newID}

	let room = newRoom{

			roomUID = newID,

			name = roomName,

			password = roomPassword,

			roomProto = (clientProto client)

			}

	processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "ADD", roomName]

	processAction (

		clID,

		newServerInfo,

		adjust (\cl -> cl{isMaster = True}) clID clients,

		insert newID room rooms

		) $ RoomAddThisClient newID

	where

		newID = (nextRoomID serverInfo) - 1

		client = clients ! clID

processAction (clID, serverInfo, clients, rooms) (RemoveRoom) = do

	processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "DEL", name clRoom]

	processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["ROOMABANDONED", name clRoom]

	return (clID,

		serverInfo,

		Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False} else cl) clients,

		delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs clRoom) (playersIDs r)}) 0 rooms

		)

	where

		clRoom = rooms ! rID

		rID = roomID client

		client = clients ! clID

processAction (clID, serverInfo, clients, rooms) (Dump) = do

	writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]

	return (clID, serverInfo, clients, rooms)