restructuring code

This commit is contained in:
nek0 2023-12-09 13:58:59 +01:00
parent 34eecc7cc0
commit b21f71ffc8
5 changed files with 58 additions and 32 deletions

View file

@ -2,8 +2,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import Control.Exception (catch, throwIO)
import Control.Monad.RWS.Strict import Control.Monad.RWS.Strict
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
@ -18,16 +16,12 @@ import Network.Socket as Net
import Options.Applicative import Options.Applicative
import System.Posix.Signals
import System.Directory
import System.IO.Error
-- internal imports -- internal imports
import Library.Types import Library.Types
import Server.Communication
import Server.Game import Server.Game
import Server.Map (generateArena) import Server.Map (generateArena)
import Server.Types import Server.Types
@ -44,21 +38,8 @@ main = do
fromString (prettyPrintParseException msg) fromString (prettyPrintParseException msg)
) )
Right (Settings {..}) -> do Right (Settings {..}) -> do
let sockAddr = SockAddrUnix setSocketPath sock <- bindSocket setSocketPath
unless (isSupportedSockAddr sockAddr) dropSocketOnSigint sock
(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
raiseSignal keyboardSignal
)
Nothing
Net.listen sock 1024 Net.listen sock 1024
putStrLn "Bound and listening to socket:" putStrLn "Bound and listening to socket:"
print =<< getSocketName sock print =<< getSocketName sock
@ -69,7 +50,7 @@ main = do
putStrLn "-----------------------------------------------------------------------------------" putStrLn "-----------------------------------------------------------------------------------"
putStrLn "starting game…" putStrLn "starting game…"
now <- getCurrentTime now <- getCurrentTime
let initRead = ReaderContainer (arenaMap arena) setFPS let initRead = ReaderContainer (arenaMap arena) setFPS sock
initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
(finalState, finalWrite) <- execRWST runGame initRead initState (finalState, finalWrite) <- execRWST runGame initRead initState
print finalWrite print finalWrite
@ -79,9 +60,3 @@ main = do
<> progDesc "Run the \"wizard-wipeout\" Server." <> progDesc "Run the \"wizard-wipeout\" Server."
<> header "wizard-wipeout - Last Mage standing" <> header "wizard-wipeout - Last Mage standing"
) )
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
where handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e

View file

@ -0,0 +1,33 @@
module Server.Communication where
import Control.Monad
import Network.Socket
import System.Posix.Signals
-- internal imports
import Server.Util
bindSocket :: FilePath -> IO Socket
bindSocket path = do
let sockAddr = SockAddrUnix path
unless (isSupportedSockAddr sockAddr)
(error $ "invalid socket path " <> path)
removeIfExists path
sock <- socket AF_UNIX Stream 0
bind sock sockAddr
pure sock
dropSocketOnSigint :: Socket -> IO ()
dropSocketOnSigint sock =
void $ installHandler
keyboardSignal
(CatchOnce $ do
(SockAddrUnix path) <- getSocketName sock
close' sock
removeIfExists path
raiseSignal keyboardSignal
)
Nothing

View file

@ -9,6 +9,8 @@ import Data.Time.Clock
import GHC.Generics import GHC.Generics
import Network.Socket
import Options.Applicative as O import Options.Applicative as O
import Library.Types import Library.Types
@ -40,6 +42,7 @@ options = Options
data ReaderContainer = ReaderContainer data ReaderContainer = ReaderContainer
{ rcMap :: ServerMap { rcMap :: ServerMap
, rcFPS :: Int , rcFPS :: Int
, rcSocket :: Socket
} }
deriving (Eq, Show) deriving (Eq, Show)

13
src-server/Server/Util.hs Normal file
View file

@ -0,0 +1,13 @@
module Server.Util where
import Control.Exception
import System.Directory
import System.IO.Error
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
where handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e

View file

@ -44,9 +44,11 @@ executable wizard-wipeout-client
executable wizard-wipeout-server executable wizard-wipeout-server
import: warnings import: warnings
main-is: Main.hs main-is: Main.hs
other-modules: Server.Game other-modules: Server.Communication
Server.Game
Server.Map Server.Map
Server.Types Server.Types
Server.Util
-- other-extensions: -- other-extensions:
build-depends: base ^>=4.17.2.1 build-depends: base ^>=4.17.2.1
, aeson , aeson