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

import Control.Monad.Reader (asks, lift)
import qualified Data (RW(..))
import qualified Game (Game(..), T(..), new, play)
import qualified Session (Status(..), T(..), Update)
import qualified Server (get, logIn, logOut, update, register)
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
import qualified Message (FromClient(..), T(..), broadcast, get, notifyPlayers, relay, send, sendTo, update)

type Vertex = Session.Status

edges :: Vertex -> Message.FromClient -> App.T Vertex

edges (Session.LoggedIn False) logIn@(Message.LogIn login) =
  asks App.key >>= App.try . (Server.logIn login)
  >>= maybe
   (Message.relay logIn Message.broadcast >> return (Session.LoggedIn True))
   (withError $ Session.LoggedIn False)

edges (Session.LoggedIn True) logOut@Message.LogOut = do
  Message.relay logOut Message.broadcast
  asks App.key >>= App.update_ . Server.logOut
  return (Session.LoggedIn False)

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

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

edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
  key <- asks App.key
  game <- Server.get gameKey <$> App.server
  newGame <- lift $ Game.play key move game
  case Game.state newGame of
    Game.Error s -> status `withError` s
    Game.Over _ -> undefined
    Game.On _ -> do
      App.update_ $ Server.update gameKey (const newGame)
      Message.notifyPlayers newGame
      return status

edges state _ =
  state `withError` ("Invalid message in state " ++ show state)

withError :: Vertex -> String -> App.T Vertex
withError vertex message = 
  (Message.send $ Message.Error message) >> return vertex

run :: App.T ()
run = do
  message <- Message.get
  status <- Session.status <$> App.current
  newStatus <- edges status message
  key <- asks App.key
  App.update_ $ Server.update key $ (Data.set newStatus :: Session.Update)
  App.debug $ show newStatus
  run

start :: App.T ()
start = do
  App.debug "Initial state"
  Message.Welcome <$> App.server <*> asks App.key >>= Message.send
  run