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

import Data.Foldable (forM_)
import Control.Monad.Reader (asks, lift)
import qualified Game (export, new)
import qualified Session (Status(..), T(..))
import qualified Server (get, logIn, logOut, setStatus, register)
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
import qualified Message (FromClient(..), T(..), broadcast, get, 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.setStatus (Session.Answering key) to)
      Message.broadcast $ Message.update {Message.paired = [key, to]}
      (Message.relay invitation $ Message.sendTo [(to, session)])
      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, session)]
      newStatus <-
        if accept
          then do
            gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
            game <- Server.get gameKey <$> App.server
            current <- App.current
            forM_ [(to, session), (key, current)] $ \(k, s) ->
              Message.sendTo [(k, s)] $ Message.NewGame $ Game.export k game
            return $ Session.Playing gameKey
          else do
            Message.broadcast $ Message.update {Message.alone = [key, to]}
            return $ Session.LoggedIn True
      App.update_ $ Server.setStatus newStatus for
      return newStatus
    _ -> (Session.LoggedIn True) `withError` "They're not waiting for your answer"

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
  asks App.key >>= App.update_ . Server.setStatus newStatus
  App.debug $ show newStatus
  run

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