{-# LANGUAGE OverloadedStrings #-}
module HWProtoInRoomState where

import qualified Data.Foldable as Foldable
import qualified Data.Map as Map
import Data.Sequence(Seq, (|>), (><), fromList, empty)
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Reader
--------------------------------------
import CoreTypes
import Actions
import Utils
import HandlerUtils
import RoomsAndClients

handleCmd_inRoom :: CmdHandler

handleCmd_inRoom ["CHAT", msg] = do
    n <- clientNick
    s <- roomOthersChans
    return [AnswerClients s ["CHAT", n, msg]]

handleCmd_inRoom ["PART"] = return [MoveToLobby "part"]
handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg]


handleCmd_inRoom ("CFG" : paramName : paramStrs)
    | null paramStrs = return [ProtocolError "Empty config entry"]
    | otherwise = do
        chans <- roomOthersChans
        cl <- thisClient
        if isMaster cl then
           return [
                ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
                AnswerClients chans ("CFG" : paramName : paramStrs)]
            else
            return [ProtocolError "Not room master"]

handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
    | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"]
    | otherwise = do
        (ci, rnc) <- ask
        r <- thisRoom
        clNick <- clientNick
        clChan <- thisClientChans
        othersChans <- roomOthersChans
        return $
            if not . null . drop 5 $ teams r then
                [Warning "too many teams"]
            else if canAddNumber r <= 0 then
                [Warning "too many hedgehogs"]
            else if isJust $ findTeam r then
                [Warning "There's already a team with same name in the list"]
            else if gameinprogress r then
                [Warning "round in progress"]
            else if isRestrictedTeams r then
                [Warning "restricted"]
            else
                [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
                ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
                AnswerClients clChan ["TEAM_ACCEPTED", name],
                AnswerClients othersChans $ teamToNet $ newTeam ci clNick r,
                AnswerClients othersChans ["TEAM_COLOR", name, color]
                ]
        where
        canAddNumber r = 48 - (sum . map hhnum $ teams r)
        findTeam = find (\t -> name == teamname t) . teams
        newTeam ci clNick r = (TeamInfo ci clNick name color grave fort voicepack flag difficulty (newTeamHHNum r) (hhsList hhsInfo))
        difficulty = case B.readInt difStr of
                           Just (i, t) | B.null t -> fromIntegral i
                           otherwise -> 0
        hhsList [] = []
        hhsList [_] = error "Hedgehogs list with odd elements number"
        hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
        newTeamHHNum r = min 4 (canAddNumber r)

handleCmd_inRoom ["REMOVE_TEAM", name] = do
        (ci, rnc) <- ask
        r <- thisRoom
        clNick <- clientNick

        let maybeTeam = findTeam r
        let team = fromJust maybeTeam

        return $
            if isNothing $ findTeam r then
                [Warning "REMOVE_TEAM: no such team"]
            else if clNick /= teamowner team then
                [ProtocolError "Not team owner!"]
            else
                [RemoveTeam name,
                ModifyClient
                    (\c -> c{
                        teamsInGame = teamsInGame c - 1,
                        clientClan = if teamsInGame c == 1 then undefined else anotherTeamClan ci r
                        })
                ]
    where
        anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
        findTeam = find (\t -> name == teamname t) . teams


handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do
    cl <- thisClient
    others <- roomOthersChans
    r <- thisRoom

    let maybeTeam = findTeam r
    let team = fromJust maybeTeam

    return $
        if not $ isMaster cl then
            [ProtocolError "Not room master"]
        else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > (canAddNumber r) + (hhnum team) then
            []
        else
            [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
            AnswerClients others ["HH_NUM", teamName, B.pack $ show hhNumber]]
    where
        hhNumber = case B.readInt numberStr of
                           Just (i, t) | B.null t -> fromIntegral i
                           otherwise -> 0
        findTeam = find (\t -> teamName == teamname t) . teams
        canAddNumber = (-) 48 . sum . map hhnum . teams



handleCmd_inRoom ["TEAM_COLOR", teamName, newColor] = do
    cl <- thisClient
    others <- roomOthersChans
    r <- thisRoom

    let maybeTeam = findTeam r
    let team = fromJust maybeTeam

    return $
        if not $ isMaster cl then
            [ProtocolError "Not room master"]
        else if isNothing maybeTeam then
            []
        else
            [ModifyRoom $ modifyTeam team{teamcolor = newColor},
            AnswerClients others ["TEAM_COLOR", teamName, newColor],
            ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})]
    where
        findTeam = find (\t -> teamName == teamname t) . teams


handleCmd_inRoom ["TOGGLE_READY"] = do
    cl <- thisClient
    chans <- roomClientsChans
    return [
        ModifyClient (\c -> c{isReady = not $ isReady cl}),
        ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}),
        AnswerClients chans [if isReady cl then "NOT_READY" else "READY", nick cl]
        ]

handleCmd_inRoom ["START_GAME"] = do
    cl <- thisClient
    r <- thisRoom
    chans <- roomClientsChans

    if isMaster cl && (playersIn r == readyPlayers r) && (not $ gameinprogress r) then
        if enoughClans r then
            return [
                ModifyRoom
                    (\r -> r{
                        gameinprogress = True,
                        roundMsgs = empty,
                        leftTeams = [],
                        teamsAtStart = teams r}
                    ),
                AnswerClients chans ["RUN_GAME"]
                ]
            else
            return [Warning "Less than two clans!"]
        else
        return []
    where
        enoughClans = not . null . drop 1 . group . map teamcolor . teams


{-
handleCmd_inRoom clID clients rooms ["EM", msg] =
    if (teamsInGame client > 0) && isLegal then
        (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
    else
        []
    where
        client = clients IntMap.! clID
        (isLegal, isKeepAlive) = checkNetCmd msg

handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
    if isMaster client then
        [ModifyRoom
                (\r -> r{
                    gameinprogress = False,
                    readyPlayers = 0,
                    roundMsgs = empty,
                    leftTeams = [],
                    teamsAtStart = []}
                ),
        UnreadyRoomClients
        ] ++ answerRemovedTeams
    else
        []
    where
        client = clients IntMap.! clID
        room = rooms IntMap.! (roomID client)
        answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
-}

handleCmd_inRoom ["TOGGLE_RESTRICT_JOINS"] = do
    cl <- thisClient
    return $
        if not $ isMaster cl then
            [ProtocolError "Not room master"]
        else
            [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]


handleCmd_inRoom ["TOGGLE_RESTRICT_TEAMS"] = do
    cl <- thisClient
    return $
        if not $ isMaster cl then
            [ProtocolError "Not room master"]
        else
            [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]

{-
handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
    [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
    where
        client = clients IntMap.! clID
        maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
        noSuchClient = isNothing maybeClient
        kickClient = fromJust maybeClient
        kickID = clientUID kickClient


handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] =
    [AnswerSameClan ["EM", engineMsg]]
    where
        client = clients IntMap.! clID
        engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
-}
handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"]