module ServerCore where

import Network
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.Chan
import Control.Monad
import qualified Data.IntMap as IntMap
import System.Log.Logger
--------------------------------------
import CoreTypes
import NetRoutines
import Utils
import HWProtoCore
import Actions

reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
reactCmd serverInfo clID cmd clients rooms = do
	(_ , serverInfo, clients, rooms) <-
		foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
	return (serverInfo, clients, rooms)

mainLoop :: Chan CoreMessage -> ServerInfo -> Clients -> Rooms -> IO ()
mainLoop coreChan serverInfo clients rooms = do
	r <- readChan coreChan
	
	(newServerInfo, mClients, mRooms) <-
		case r of
			Accept ci -> do
				let updatedClients = IntMap.insert (clientUID ci) ci clients
				--infoM "Clients" ("New client: id " ++ (show $ clientUID ci))
				processAction
					(clientUID ci, serverInfo, updatedClients, rooms)
					(AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])
				return (serverInfo, updatedClients, rooms)

			ClientMessage (clID, cmd) -> do
				debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
				if clID `IntMap.member` clients then
					reactCmd serverInfo clID cmd clients rooms
					else
					do
					debugM "Clients" "Message from dead client"
					return (serverInfo, clients, rooms)

	{-			let hadRooms = (not $ null rooms) && (null mrooms)
					in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
						mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}

	mainLoop coreChan newServerInfo mClients mRooms

startServer :: ServerInfo -> Chan CoreMessage -> Socket -> IO ()
startServer serverInfo coreChan serverSocket = do
	putStrLn $ "Listening on port " ++ show (listenPort serverInfo)

	forkIO $
		acceptLoop
			serverSocket
			coreChan
			0

	return ()
	
{-	forkIO $ messagesLoop messagesChan
	forkIO $ timerLoop messagesChan-}

--	startDBConnection $ dbQueries serverInfo

	mainLoop coreChan serverInfo IntMap.empty (IntMap.singleton 0 newRoom)