{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveGeneric #-}
module Message (
      FromClient(..)
    , T(..)
    , broadcast
    , receive
    , relay
    , send
  ) where

import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions)
import Network.WebSockets (receiveData, sendTextData)
import Data.ByteString.Lazy.Char8 (unpack)
import Control.Monad (mapM_)
import Control.Monad.Reader (lift)
import qualified Player (Login(..), Name, T(..))
import qualified Server (T(..))
import qualified Session (App, connection, debug, get, player)
import qualified Hanafuda.KoiKoi as KoiKoi (Move(..))
import GHC.Generics (Generic)
import Game ()

data FromClient =
    Answer {accept :: Bool}
  | Invitation {to :: Player.Name}
  | LogIn {name :: Player.Name}
  | LogOut
  | Game {move :: KoiKoi.Move}
  | Ping
  deriving (Generic)

instance ToJSON FromClient where
  toEncoding = genericToEncoding defaultOptions
instance FromJSON FromClient where
  parseJSON = genericParseJSON defaultOptions

data T =
    Relay {from :: Player.Name, message :: FromClient}
  | Welcome {room :: Server.T}
  | Pong
  | Error {error :: String}
  deriving (Generic)

instance ToJSON T where
  toEncoding = genericToEncoding defaultOptions

sendTo :: T -> Player.T -> Session.App ()
sendTo obj player = do
  Session.debug $ '(' : playerLogin ++ ") <" ++ (unpack encoded)
  lift $ sendTextData (Player.connection player) $ encoded
  where
    encoded = encode $ obj
    playerLogin = unpack $ encode $ Player.login player

send :: T -> Session.App ()
send obj =
  (obj `sendTo`) =<< Session.player

broadcast :: T -> Session.App ()
broadcast obj =
  Session.get Server.bySessionId
  >>= mapM_ (obj `sendTo`)

relay :: FromClient -> (T -> Session.App ()) -> Session.App ()
relay message f =
  Session.debug "Relaying"
  >> Session.player >>= (ifLoggedIn . Player.login)
  >> Session.debug "Relayed"
  where
    ifLoggedIn Player.Anonymous = return ()
    ifLoggedIn (Player.Login from) = f $ Relay {from, message}

receive :: Session.App FromClient
receive = do
  received <- ((lift . receiveData) =<< Session.connection)
  Session.debug $ '>':(unpack received)
  case eitherDecode' received of
    Left errorMessage -> send (Message.Error errorMessage) >> receive
    Right clientMessage -> return clientMessage