module ServerCore where

import Network
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad
import qualified Data.IntMap as IntMap
import System.Log.Logger
import Control.Monad.Reader
import Control.Monad.State
--------------------------------------
import CoreTypes
import NetRoutines
import HWProtoCore
import Actions
import OfficialServer.DBInteraction
import ServerState


timerLoop :: Int -> Chan CoreMessage -> IO()
timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan


reactCmd :: [String] -> StateT ServerState IO ()
reactCmd cmd = do
    (Just ci) <- gets clientIndex
    rnc <- gets roomsClients
    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
    forM_ actions processAction

mainLoop :: StateT ServerState IO ()
mainLoop = forever $ do
    si <- gets serverInfo
    r <- liftIO $ readChan $ coreChan si

    case r of
        Accept ci -> do
            processAction (AddClient ci)
            return ()

        ClientMessage (ci, cmd) -> do
            liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd)
            modify (\as -> as{clientIndex = Just ci})
            --if clID `IntMap.member` clients then
            reactCmd cmd
            return ()
                --else
                --do
                --debugM "Clients" "Message from dead client"
                --return (serverInfo, rnc)

        ClientAccountInfo (clID, info) -> do
            --if clID `IntMap.member` clients then
            processAction (ProcessAccountInfo info)
            return ()
                --else
                --do
                --debugM "Clients" "Got info for dead client"
                --return (serverInfo, rnc)

        TimerAction tick ->
            return ()
            --liftM snd $
            --    foldM processAction (0, serverInfo, rnc) $
            --        PingAll : [StatsAction | even tick]

        FreeClient ci -> do
            rnc <- gets roomsClients
            liftIO $ removeClient rnc ci


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

    forkIO $
        acceptLoop
            serverSocket
            (coreChan serverInfo)

    return ()

    forkIO $ timerLoop 0 $ coreChan serverInfo

    startDBConnection serverInfo

    rnc <- newRoomsAndClients newRoom

    forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo rnc)

    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"