50 lines
1.3 KiB
Haskell
50 lines
1.3 KiB
Haskell
{-# 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 Prelude hiding (log, putStrLn)
|
|
import qualified Area (Key(..))
|
|
import qualified Character (new)
|
|
import Game (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 Game
|
|
edges Empty Client.NewGame = return $ Game {
|
|
character = Character.new
|
|
, state = At $ Position {
|
|
area = Area.Key 0
|
|
, x = 0
|
|
, y = 0
|
|
}
|
|
}
|
|
|
|
edges Empty (Client.Resume {Client.game}) = return game
|
|
|
|
edges game message = do
|
|
let errorMessage = "inacceptable message " `mappend` encode message `mappend` " in this context"
|
|
send (Server.Error $ unpack errorMessage)
|
|
log errorMessage
|
|
return game
|
|
|
|
log :: ByteString -> Connected ()
|
|
log line =
|
|
liftIO $ putStrLn line
|
|
|
|
run :: Connected ()
|
|
run = do
|
|
message <- Message.receive
|
|
game <- get
|
|
newGame <- edges game message
|
|
log $ encode newGame
|
|
put newGame
|
|
send $ Server.Game newGame
|
|
run
|