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

import Control.Monad.State (get, put)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (encode)
import Data.ByteString.Lazy.Char8 (ByteString, putStrLn, unpack)
import Data.Vector ((!))
import Prelude hiding (log, putStrLn)
import qualified Area (Key(..), dex)
import qualified Character (new)
import Game (Direction(..), Game(..), Position(..), State(..))
import Message (Connected, receive, send)
import qualified Message.Client as Client (Message(..))
import qualified Message.Server as Server (Message(..))

edges :: Game -> Client.Message -> Connected ()
edges Empty Client.NewGame = set $ Game {
      character = Character.new
    , state = At $ Position {
          area = Area.Key 0
        , x = 0
        , y = 0
        , direction = S
      }
  }

edges Empty (Client.Resume {Client.game}) = set game

edges game@(Game {state = At position}) (Client.Move {Client.to}) =
  set $ game {state = At newPosition}
  where
    newPosition
      | direction position == to =
        let (dx, dy) =
              case to of
                N -> (0, -1)
                S -> (0, 1)
                E -> (1, 0)
                W -> (-1, 0)
              in
        position { x = x position + dx, y = y position + dy }
      | otherwise = position { direction = to }

edges _ (Client.Load {Client.area}) =
  case area of
    Area.Key n -> send . Server.Area $ Area.dex ! n

edges _ message = do
  let errorMessage = "inacceptable message " `mappend` encode message `mappend` " in this context"
  send (Server.Error $ unpack errorMessage)
  log errorMessage

log :: ByteString -> Connected ()
log line =
  liftIO $ putStrLn line

set :: Game -> Connected ()
set game = do
  log $ encode game
  put game
  send $ Server.Game game

run :: Connected ()
run = do
  message <- Message.receive
  game <- get
  edges game message
  run