{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module Messaging (
      FromClient(..)
    , T(..)
    , broadcast
    , get
    , notifyPlayers
    , receive
    , relay
    , send
    , sendTo
    , update
  ) where

import Data.List (intercalate)
import Data.Foldable (forM_)
import Data.Map (keys)
import Data.Aeson (eitherDecode', encode)
import Network.WebSockets (receiveData, sendTextData)
import Data.ByteString.Lazy.Char8 (unpack)
import Control.Monad.Reader (asks, lift)
import qualified Game (export)
import qualified Session (T(..))
import qualified Server (T(..), get)
import qualified App (Context(..), T, connection, debug, server)
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game, GameBlueprint(..), PlayerID)
import qualified Hanafuda.Message as Message (T)
import Hanafuda.Message (FromClient(..), T(..))

sendTo :: [KoiKoi.PlayerID] -> Message.T -> App.T ()
sendTo playerIDs obj = do
  sessions <- getSessions <$> App.server
  App.debug $ '(' : intercalate ", " recipients ++ ") <" ++ (unpack encoded)
  lift $ forM_ (Session.connection <$> sessions) $ flip sendTextData encoded
  where
    encoded = encode $ obj
    getSessions server = (\playerID -> Server.get playerID server) <$> playerIDs
    recipients = show <$> playerIDs

send :: Message.T -> App.T ()
send obj = do
  playerID <- asks App.playerID
  sendTo [playerID] obj

broadcast :: Message.T -> App.T ()
broadcast obj =
  App.server >>= flip sendTo obj . keys . Server.sessions

relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
relay message f = do
  App.debug "Relaying"
  (\from -> f $ Relay {from, message}) =<< asks App.playerID

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

get :: App.T FromClient
get =
  receive >>= pong
  where
    pong Ping = send Pong >> get
    pong m = return m

update :: T
update = Update {alone = [], paired = []}

notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
notifyPlayers game logs =
  forM_ (keys $ KoiKoi.scores game) $ \k ->
    sendTo [k] $ Game {game = Game.export k game, logs}