{-# 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" )