{-# LANGUAGE NamedFieldPuns #-}
module Automaton (
    start
  ) where

import Control.Monad.Reader (asks)
import qualified Data (RW(..))
import Data.Map (Map, (!?))
import qualified Game (new, play)
import qualified Hanafuda.KoiKoi as KoiKoi (
    Game, GameBlueprint(..), GameID, Step(..)
  )
import qualified Session (Status(..), T(..), Update)
import qualified Server (endGame, get, logIn, logOut, update, room)
import qualified App (Context(..), T, current, debug, get, server, try, update_)
import qualified Hanafuda.Message as Message (FromClient(..), T(..))
import qualified Messaging (
    broadcast, get, notifyPlayers, relay, send, sendTo, update
  )

receive :: Session.Status -> Message.FromClient -> App.T ()

receive (Session.LoggedIn False) logIn@(Message.LogIn login) =
  asks App.playerID >>= App.try . (Server.logIn login)
  >>= maybe
   (Messaging.relay logIn Messaging.broadcast >> setSessionStatus (Session.LoggedIn True))
   sendError

receive (Session.LoggedIn True) logOut@Message.LogOut = do
  Messaging.relay logOut Messaging.broadcast
  asks App.playerID >>= App.update_ . Server.logOut
  setSessionStatus (Session.LoggedIn False)

receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
  session <- App.get to
  case Session.status session of
    Session.LoggedIn True -> do
      from <- asks App.playerID
      App.update_ (Server.update to (Data.set $ Session.Answering from :: Session.Update))
      Messaging.broadcast $ Messaging.update {Message.paired = [from, to]}
      (Messaging.relay invitation $ Messaging.sendTo [to])
      setSessionStatus (Session.Waiting to)
    _ -> sendError "They just left"

receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
  session <- App.get to
  playerID <- asks App.playerID
  case Session.status session of
    Session.Waiting for | for == playerID -> do
      Messaging.relay message $ Messaging.sendTo [to]
      newStatus <-
        if accept
          then do
            gameID <- Game.new (for, to)
            game <- Server.get gameID <$> App.server
            Messaging.notifyPlayers game []
            return $ Session.Playing gameID
          else do
            Messaging.broadcast $ Messaging.update {Message.alone = [for, to]}
            return $ Session.LoggedIn True
      App.update_ $ Server.update to (Data.set newStatus :: Session.Update)
      setSessionStatus newStatus
    _ -> sendError "They're not waiting for your answer"

receive (Session.Playing gameID) played@(Message.Play {}) = do
  playerID <- asks App.playerID
  game <- Server.get gameID <$> App.server
  (result, logs) <- Game.play playerID (Message.move played) game
  case result of
    Left message -> sendError message
    Right newGame -> do
      case KoiKoi.step newGame of
        KoiKoi.Over -> do
          App.debug $ "Game " ++ show gameID ++ " ended"
          App.update_ $ Server.endGame gameID
        _ -> App.update_ $ Server.update gameID (const newGame)
      Messaging.notifyPlayers newGame logs

receive (Session.Playing gameID) Message.Quit = do
  games <- (Data.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game))
  case games !? gameID of
    Nothing -> do
      playerID <- asks App.playerID
      Messaging.broadcast $ Messaging.update {Message.alone = [playerID]}
      setSessionStatus (Session.LoggedIn True)
    _ -> sendError "Game is still running"

receive state _ = sendError $ "Invalid message in state " ++ show state

sendError :: String -> App.T ()
sendError = Messaging.send . Message.Error

setSessionStatus :: Session.Status -> App.T ()
setSessionStatus newStatus = do
  playerID <- asks App.playerID
  App.update_ $ Server.update playerID $ (Data.set newStatus :: Session.Update)
  App.debug $ show newStatus

loop :: App.T ()
loop = do
  message <- Messaging.get
  status <- Session.status <$> App.current
  status `receive` message
  loop

start :: App.T ()
start = do
  App.debug "Initial state"
  Message.Welcome . Server.room <$> App.server <*> asks App.playerID >>= Messaging.send
  loop