{-# LANGUAGE OverloadedStrings #-}
module Utils where

import Data.Char
import Data.Word
import qualified Data.Map as Map
import qualified Data.Char as Char
import Numeric
import Network.Socket
import System.IO
import qualified Data.List as List
import Control.Monad
import qualified Data.ByteString.Lazy as BL
import qualified Text.Show.ByteString as BS
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as UTF8
import Data.Maybe
-------------------------------------------------
import CoreTypes


sockAddr2String :: SockAddr -> IO B.ByteString
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) =
    return $ B.pack $ (foldr1 (.)
        $ List.intersperse (':':)
        $ concatMap (\n -> (\(a0, a1) -> [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) []

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
    [(x, rest)] | all isSpace rest -> Just x
    _         -> Nothing

teamToNet :: TeamInfo -> [B.ByteString]
teamToNet team =
        "ADD_TEAM"
        : teamname team
        : teamgrave team
        : teamfort team
        : teamvoicepack team
        : teamflag team
        : teamowner team
        : (showB . difficulty $ team)
        : hhsInfo
    where
        hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team

modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo
modifyTeam team room = room{teams = replaceTeam team $ teams room}
    where
    replaceTeam _ [] = error "modifyTeam: no such team"
    replaceTeam tm (t:ts) =
        if teamname tm == teamname t then
            tm : ts
        else
            t : replaceTeam tm ts

illegalName :: B.ByteString -> Bool
illegalName b = B.null b || length s > 40 || all isSpace s || isSpace (head s) || isSpace (last s) || any isIllegalChar s
    where
        s = UTF8.toString b
        isIllegalChar c = c `List.elem` ("$()*+?[]^{|}\x7F" ++ ['\x00'..'\x1F'])

protoNumber2ver :: Word16 -> B.ByteString
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap
    where
        vermap = Map.fromList [
            (17, "0.9.7-dev")
            , (19, "0.9.7")
            , (20, "0.9.8-dev")
            , (21, "0.9.8")
            , (22, "0.9.9-dev")
            , (23, "0.9.9")
            , (24, "0.9.10-dev")
            , (25, "0.9.10")
            , (26, "0.9.11-dev")
            , (27, "0.9.11")
            , (28, "0.9.12-dev")
            , (29, "0.9.12")
            , (30, "0.9.13-dev")
            , (31, "0.9.13")
            , (32, "0.9.14-dev")
            , (33, "0.9.14")
            , (34, "0.9.15-dev")
            , (35, "0.9.14.1")
            , (37, "0.9.15")
            , (38, "0.9.16-dev")
            , (39, "0.9.16")
            , (40, "0.9.17-dev")
            , (41, "0.9.17")
            , (42, "0.9.18-dev")
            , (43, "0.9.18")
            , (44, "0.9.19-dev")
            , (45, "0.9.19")
            , (46, "0.9.20-dev")
            , (47, "0.9.20")
            , (48, "0.9.21-dev")
            ]

askFromConsole :: B.ByteString -> IO B.ByteString
askFromConsole msg = do
    B.putStr msg
    hFlush stdout
    B.getLine


unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b)
unfoldrE f b  =
    case f b of
        Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b')
        Left new_b       -> ([], new_b)

showB :: (BS.Show a) => a -> B.ByteString
showB = B.concat . BL.toChunks . BS.show

readInt_ :: (Num a) => B.ByteString -> a
readInt_ str =
  case B.readInt str of
       Just (i, t) | B.null t -> fromIntegral i
       _                      -> 0

cutHost :: B.ByteString -> B.ByteString
cutHost = B.intercalate "." .  flip (++) ["*","*"] . List.take 2 . B.split '.'

caseInsensitiveCompare :: B.ByteString -> B.ByteString -> Bool
caseInsensitiveCompare a b = upperCase a == upperCase b

upperCase :: B.ByteString -> B.ByteString
upperCase = UTF8.fromString . map Char.toUpper . UTF8.toString

roomInfo :: Word16 -> B.ByteString -> RoomInfo -> [B.ByteString]
roomInfo p n r
    | p < 46 = [
        showB $ isJust $ gameInfo r,
        name r,
        showB $ playersIn r,
        showB $ length $ teams r,
        n,
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
        head (Map.findWithDefault ["Default"] "AMMO" (params r))
        ]
    | otherwise = [
        showB $ isJust $ gameInfo r,
        name r,
        showB $ playersIn r,
        showB $ length $ teams r,
        n,
        Map.findWithDefault "+rnd+" "MAP" (mapParams r),
        head (Map.findWithDefault ["Normal"] "SCRIPT" (params r)),
        head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
        head (Map.findWithDefault ["Default"] "AMMO" (params r))
        ]

answerFullConfigParams ::
            ClientInfo
            -> Map.Map B.ByteString B.ByteString
            -> Map.Map B.ByteString [B.ByteString]
            -> [Action]
answerFullConfigParams cl mpr pr
        | clientProto cl < 38 = map (toAnswer cl) $
                (reverse . map (\(a, b) -> (a, [b])) $ Map.toList mpr)
                ++ (("SCHEME", pr Map.! "SCHEME")
                : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr))

        | otherwise = map (toAnswer cl) $
                ("FULLMAPCONFIG", Map.elems mpr)
                : ("SCHEME", pr Map.! "SCHEME")
                : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)
    where
        toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs


answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
answerAllTeams cl = concatMap toAnswer
    where
        clChan = sendChan cl
        toAnswer team =
            [AnswerClients [clChan] $ teamToNet team,
            AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
            AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]


loc :: B.ByteString -> B.ByteString
loc = id

maybeNick :: Maybe ClientInfo -> B.ByteString
maybeNick = fromMaybe "[]" . liftM nick

-- borrowed from Data.List, just more general in types
deleteBy2                :: (a -> b -> Bool) -> a -> [b] -> [b]
deleteBy2 _  _ []        = []
deleteBy2 eq x (y:ys)    = if x `eq` y then ys else y : deleteBy2 eq x ys

deleteFirstsBy2          :: (a -> b -> Bool) -> [a] -> [b] -> [a]
deleteFirstsBy2 eq       =  foldl (flip (deleteBy2 (flip eq)))