{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Server (
      SessionId
    , T(..)
    , disconnect
    , join
    , logIn
    , logOut
    , new
  ) where

import Data.Vector (fromList)
import Data.Aeson (ToJSON(..), Value(Array))
import Data.Map ((!), (!?), Map, adjust, delete, elems, empty, insert, lookupMax)
import qualified Data (RW(..))
import qualified Player (Login(..), Name(..), T(..))

newtype SessionId = SessionId Int deriving (Eq, Ord, Read, Show)
type Players = Map SessionId Player.T
type SessionIds = Map Player.Name SessionId
data T = T {
      byName :: SessionIds
    , bySessionId :: Players
  }

instance Data.RW SessionIds T where
  update f server@(T {byName}) = server {byName = f byName}

instance Data.RW Players T where
  update f server@(T {bySessionId}) = server {bySessionId = f bySessionId}

loggedInPlayers :: T -> [Player.T]
loggedInPlayers (T {byName, bySessionId}) =
  [(bySessionId ! sessionId) | sessionId <- elems byName]

instance ToJSON T where
  toJSON = Array . fromList . (toJSON <$>) . loggedInPlayers
  toEncoding = toEncoding . loggedInPlayers

new :: T
new = T {
      byName = empty
    , bySessionId = empty
  }

join :: Player.T -> T -> IO (T, SessionId)
join player server@(T {bySessionId}) =
  return (Data.update (insert sessionId player) server, sessionId)
  where
    sessionId = SessionId $ maybe 0 (\(SessionId n, _) -> n+1) $ lookupMax bySessionId

disconnect :: SessionId -> T -> Either String T
disconnect sessionId server =
  Data.update (delete sessionId :: Players -> Players) <$> logOut sessionId server

logIn :: Player.Name -> SessionId -> T -> Either String T
logIn name sessionId server =
  Data.update (adjust (Data.set (Player.Login name) :: Player.T -> Player.T) sessionId) <$>
  Data.update (insert name sessionId) <$>
  maybe (Right server) (\_ -> Left "This name is already registered") maybeName
  where
    maybeName = byName server !? name

logOut :: SessionId -> T -> Either String T
logOut sessionId server@(T {bySessionId}) =
  Right $ Data.update (adjust (Data.set Player.Anonymous :: Player.T -> Player.T) sessionId) $
  (case Player.login $ bySessionId ! sessionId of
    (Player.Login name) -> Data.update (delete name :: SessionIds -> SessionIds) server
    Player.Anonymous -> server)