wizard-wipeout/src-server/Main.hs
2023-12-09 13:24:33 +01:00

86 lines
2.4 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Exception (catch, throwIO)
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
import System.Posix.Signals
import System.Directory
import System.IO.Error
-- 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)
removeIfExists setSocketPath
sock <- socket AF_UNIX Stream 0
bind sock sockAddr
touchSocket sock
void $ installHandler
keyboardSignal
(CatchOnce $ do
close' sock
removeIfExists setSocketPath
)
Nothing
Net.listen sock 1024
putStrLn "Bound and listening 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"
)
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
where handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e