wizard-wipeout/src-server/Main.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Concurrent (threadDelay)

import qualified Control.Concurrent.STM as STM

import Control.Monad.RWS.Strict

import qualified Data.ByteString.Char8 as B8

import Data.String (fromString)

import Data.Time

import Data.Yaml

import Network.Socket as Net

import Options.Applicative

-- internal imports

import Library.Map
import Library.Types

import Server.Communication
import Server.Game
import Server.Log
import Server.Map (generateArena)
import Server.Types
import Server.Util

main :: IO ()
main = do
  putStrLn "Hello, Wizards!"
  (Options optSettingLoc) <- execParser opts
  raw <- B8.readFile optSettingLoc
  case decodeEither' raw of
    Left msg -> 
      error (optSettingLoc <> ":" <>
        " error: " <>
        fromString (prettyPrintParseException msg)
        )
    Right (Settings {..}) -> do
      sock <- bindSocket setSocketPath
      let logLevel = setLogLevel
      logPrintIO logLevel Info "Bound and listening to socket:"
      logPrintIO logLevel Info . show =<< getSocketName sock
      logPrintIO logLevel Info "-----------------------------------------------------------------------------------"
      arena <- generateArena setMapRows setMapColumns setSpawnerProbability
      logPrintIO logLevel Info "generated arena:"
      prettyPrintMap (arenaMap arena)
      logPrintIO logLevel Info "-----------------------------------------------------------------------------------"
      logPrintIO logLevel Info "starting game…"
      now <- getCurrentTime
      sockList <- STM.newTMVarIO []
      queueList <- STM.newTMVarIO []
      messageQueue <- STM.newTQueueIO
      serverState <- STM.newTMVarIO (ServerState False False)
      emptyPLayers <- STM.newTMVarIO []
      let initRead  = ReaderContainer
            (arenaMap arena)
            setFPS
            setFramesPerPing
            setClientMaxTimeout
            sock
            logLevel
          initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList queueList messageQueue
      (finalState, finalWrite) <- execRWST
        (do
          terminateGameOnSigint
          runGame
        )
        initRead
        initState
      removeIfExists setSocketPath
      threadDelay 1000
      putStrLn "bye bye"
  where
    opts = info (options <**> helper)
      ( fullDesc
        <> progDesc "Run the \"wizard-wipeout\" Server."
        <> header "wizard-wipeout - Last Mage standing"
        )