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

-- | A handler for a battlesnake server request.
type GameRequestHandler a = GameRequest -> IO a

{-|
  Run a battlesnake server. Runs the server on the port specified by the environment variable "PORT" or port 3000 if the variable is not set.

  * An IO action that returns a "Battlesnake.API.InfoResponse" which is run on info requests.

  * A 'GameRequestHandler' to be called when the server receives a start request.

  * A 'GameRequestHandler' to be called when the server receives a move request.

  * A 'GameRequestHandler' to be called when the server receives an end request.
-}
runBattlesnakeServer
  :: IO Info.InfoResponse
  -> GameRequestHandler ()
  -> GameRequestHandler MoveResponse
  -> GameRequestHandler ()
  -> IO ()
runBattlesnakeServer :: IO InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> IO ()
runBattlesnakeServer IO 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
$
    IO InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> ScottyM ()
routes
      IO InfoResponse
info
      GameRequestHandler ()
startHandler
      GameRequestHandler MoveResponse
moveHandler
      GameRequestHandler ()
endHandler

routes
  :: IO Info.InfoResponse
  -> GameRequestHandler ()
  -> GameRequestHandler MoveResponse
  -> GameRequestHandler ()
  -> ScottyM ()
routes :: IO InfoResponse
-> GameRequestHandler ()
-> GameRequestHandler MoveResponse
-> GameRequestHandler ()
-> ScottyM ()
routes IO InfoResponse
info GameRequestHandler ()
startHandler GameRequestHandler MoveResponse
moveHandler GameRequestHandler ()
endHandler = do
  RoutePattern -> ActionM () -> ScottyM ()
get RoutePattern
"/" forall a b. (a -> b) -> a -> b
$ IO InfoResponse -> ActionM ()
handleInfoRequest IO 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 :: IO Info.InfoResponse -> ActionM ()
handleInfoRequest :: IO InfoResponse -> ActionM ()
handleInfoRequest IO InfoResponse
info = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO InfoResponse
info forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 ()