module Battlesnake.Server (GameRequestHandler, runBattlesnakeServer) where
import Battlesnake.API.GameRequest
import qualified Battlesnake.API.InfoResponse as Info
import Battlesnake.API.MoveResponse
import Control.Monad.IO.Class (liftIO)
import Data.Functor ((<&>))
import Data.Maybe (fromMaybe)
import System.Environment (lookupEnv)
import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout)
import Text.Read (readMaybe)
import Web.Scotty
type GameRequestHandler a = GameRequest -> IO a
runBattlesnakeServer ::
Info.InfoResponse ->
GameRequestHandler () ->
GameRequestHandler MoveResponse ->
GameRequestHandler () ->
IO ()
runBattlesnakeServer :: InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> IO ()
runBattlesnakeServer InfoResponse
info GameRequestHandler ()
startHandler GameRequestHandler MoveResponse
moveHandler GameRequestHandler ()
endHandler = do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Maybe Port
envPort <- String -> IO (Maybe String)
lookupEnv String
"PORT" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. Read a => String -> Maybe a
readMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
Port -> ScottyM () -> IO ()
scotty (forall a. a -> Maybe a -> a
fromMaybe Port
3000 Maybe Port
envPort) forall a b. (a -> b) -> a -> b
$
InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> ScottyM ()
routes
InfoResponse
info
GameRequestHandler ()
startHandler
GameRequestHandler MoveResponse
moveHandler
GameRequestHandler ()
endHandler
routes ::
Info.InfoResponse ->
GameRequestHandler () ->
GameRequestHandler MoveResponse ->
GameRequestHandler () ->
ScottyM ()
routes :: InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> ScottyM ()
routes InfoResponse
info GameRequestHandler ()
startHandler GameRequestHandler MoveResponse
moveHandler GameRequestHandler ()
endHandler = do
RoutePattern -> ActionM () -> ScottyM ()
get RoutePattern
"/" forall a b. (a -> b) -> a -> b
$ InfoResponse -> ActionM ()
handleInfoRequest InfoResponse
info
RoutePattern -> ActionM () -> ScottyM ()
post RoutePattern
"/start" forall a b. (a -> b) -> a -> b
$ GameRequestHandler () -> ActionM ()
handleStartRequest GameRequestHandler ()
startHandler
RoutePattern -> ActionM () -> ScottyM ()
post RoutePattern
"/move" forall a b. (a -> b) -> a -> b
$ GameRequestHandler MoveResponse -> ActionM ()
handleMoveRequest GameRequestHandler MoveResponse
moveHandler
RoutePattern -> ActionM () -> ScottyM ()
post RoutePattern
"/end" forall a b. (a -> b) -> a -> b
$ GameRequestHandler () -> ActionM ()
handleEndRequest GameRequestHandler ()
endHandler
handleInfoRequest :: Info.InfoResponse -> ActionM ()
handleInfoRequest :: InfoResponse -> ActionM ()
handleInfoRequest = forall a. ToJSON a => a -> ActionM ()
json
handleStartRequest :: GameRequestHandler () -> ActionM ()
handleStartRequest :: GameRequestHandler () -> ActionM ()
handleStartRequest GameRequestHandler ()
handler = do
GameRequest
gameRequest <- forall a. FromJSON a => ActionM a
jsonData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ GameRequestHandler ()
handler GameRequest
gameRequest
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleMoveRequest :: GameRequestHandler MoveResponse -> ActionM ()
handleMoveRequest :: GameRequestHandler MoveResponse -> ActionM ()
handleMoveRequest GameRequestHandler MoveResponse
handler = do
GameRequest
gameRequest <- forall a. FromJSON a => ActionM a
jsonData
MoveResponse
nextMove <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ GameRequestHandler MoveResponse
handler GameRequest
gameRequest
forall a. ToJSON a => a -> ActionM ()
json MoveResponse
nextMove
handleEndRequest :: GameRequestHandler () -> ActionM ()
handleEndRequest :: GameRequestHandler () -> ActionM ()
handleEndRequest GameRequestHandler ()
handler = do
GameRequest
gameRequest <- forall a. FromJSON a => ActionM a
jsonData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ GameRequestHandler ()
handler GameRequest
gameRequest
forall (m :: * -> *) a. Monad m => a -> m a
return ()