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

import AI (move)
import Control.Concurrent (forkIO, threadDelay)
import Data.Aeson (encode, eitherDecode')
import Data.ByteString.Lazy.Char8 (ByteString, append, pack, putStrLn)
import qualified Data.ByteString.Lazy.Char8 as ByteString (concat)
import Data.Map (Map, empty)
import Data.Text (Text)
import Control.Concurrent (threadDelay)
import Control.Monad.Reader (ReaderT, ask)
import Control.Monad.State (StateT)
import Control.Monad.Trans (lift)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), PlayerID, Step(..))
import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame)
import Network.WebSockets (Connection, receiveData, sendTextData)
import Prelude hiding (error, putStrLn)
import System.Exit (exitSuccess)

data State =
    Initial
  | Connected {
        key :: PlayerID
    }
  | LoggedIn {
        key :: PlayerID
      , name :: Text
    }
  | Playing {
        key :: PlayerID
      , name :: Text
      , against :: PlayerID
    }
  deriving Show

type App a = ReaderT Connection IO a

sendIO :: Message.FromClient -> Connection -> IO ()
sendIO message connection = do
  putStrLn $ ">" `append` encoded
  sendTextData connection encoded
  where
    encoded = encode message

send :: Message.FromClient -> App ()
send message =
  ask >>= lift . sendIO message

receive :: App Message.T
receive = do
  received <- ask >>= lift . receiveData
  debug $ "<" `append` received
  case eitherDecode' received of
    Left errorMessage -> debug (pack errorMessage) >> receive
    Right message -> return message

debug :: ByteString -> App ()
debug message = lift $ putStrLn message

answer :: Message.T -> State -> App State
answer welcome@(Message.Welcome {}) Initial = do
  send $ Message.LogIn {Message.name = "Hannah"}
  return $ Connected {key = Message.key welcome}

answer (Message.Relay {Message.from, Message.message = Message.LogIn {Message.name}}) (Connected {key})
  | from == key = return $ LoggedIn {key, name}

answer (Message.Relay {Message.from, Message.message = Message.Invitation {}}) (LoggedIn {key, name}) = do
  send $ Message.Answer {Message.accept = True}
  return $ Playing {key, name, against = from}

answer (Message.Relay {Message.message = Message.Invitation {}}) state = do
  send $ Message.Answer {Message.accept = False}
  return state

answer (Message.Game {Message.game, Message.logs}) state@(Playing {key, name}) = do
  case step game of
    Over -> send Message.Quit >> return (LoggedIn {key, name})
    _ -> do
      if playing game == key
      then send (Message.Play {Message.move = AI.move key game}) >> return state
      else return state

answer (Message.Relay {Message.from, Message.message = Message.LogOut}) (Playing {key, name, against})
  | from == against = send Message.Quit >> return (LoggedIn {key, name})

answer (Message.Relay {}) state = return state

answer Message.Pong state = ping >> return state

answer (Message.Error {Message.error}) state = do
  debug $ "Received error from server : " `append` pack error
  return state

answer message state = do
  debug $ ByteString.concat [
      "Unexpected message : ", encode message, " in state ", pack $ show state
    ]
  return state

ping = do
  connection <- ask
  setTimeout (20*s) (sendIO Message.Ping connection)
  where
    setTimeout delay callback =
      const () <$> (lift $ forkIO (threadDelay delay >> callback))
    ms = 1000
    s = 1000 * ms

start :: App ()
start = ping >> loop Initial
  where
    loop state = do
      newMessage <- receive
      answer newMessage state >>= loop