wizard-wipeout/src-server/Main.hs

68 lines
2.1 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
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
import Options.Applicative
-- internal imports
import Library.Types
import Server.Game
import Server.Map (generateArena)
import Server.Types
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
let sockAddr = SockAddrUnix setSocketPath
unless (isSupportedSockAddr sockAddr)
(error $ "invalid socket path " <> setSocketPath)
let hints = defaultHints
{ addrFamily = AF_UNIX
, addrSocketType = Stream
, addrAddress = sockAddr
}
addr <- head <$> getAddrInfo (Just hints) Nothing Nothing
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
bind sock (addrAddress addr)
putStrLn "Bound to socket:"
print =<< getSocketName sock
putStrLn "-----------------------------------------------------------------------------------"
arena <- generateArena setMapRows setMapColumns setSpawnerProbability
putStrLn "generated arena:"
print (arenaMap arena)
putStrLn "-----------------------------------------------------------------------------------"
putStrLn "starting game…"
now <- getCurrentTime
let initRead = ReaderContainer (arenaMap arena) setFPS
initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
(finalState, finalWrite) <- execRWST runGame initRead initState
print finalWrite
where
opts = info (options <**> helper)
( fullDesc
<> progDesc "Run the \"wizard-wipeout\" Server."
<> header "wizard-wipeout - Last Mage standing"
)