50 lines
1.4 KiB
Haskell
50 lines
1.4 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 Character (Character(..))
|
|
import Game (Game(..), InitProcess(..), State(..), stub)
|
|
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 (Game {state = Start}) Client.NewGame = return $ Game.stub {
|
|
state = Initializing Name
|
|
}
|
|
|
|
edges (Game {state = Start}) (Client.Resume {Client.game}) = return game
|
|
|
|
edges (Game {state = Initializing Name, character}) (Client.Initialize {Client.step = Name, Client.value}) = return $ Game {
|
|
character = character { name = value }
|
|
, state = Initializing Skin
|
|
}
|
|
|
|
edges game message = do
|
|
let errorMessage = "inacceptable message " <> encode message <> " 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
|