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

import Control.Monad.Except (runExceptT)
import Control.Monad.Reader (asks, lift)
import Control.Monad.Writer (runWriterT)
import qualified Data (RW(..))
import qualified Game (new, play)
import qualified Hanafuda.KoiKoi as KoiKoi (Game(..))
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
  (result, logs) <- lift . runWriterT . runExceptT $ Game.play key move game
  case result of
    Left message -> status `withError` message
    Right newGame ->
      case newGame of
        KoiKoi.Over _ -> undefined
        KoiKoi.On on -> do
          App.update_ $ Server.update gameKey (const on)
          Message.notifyPlayers on logs
          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