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 #-}
module Main where
import Control.Exception (catch, throwIO)
import Control.Monad.RWS.Strict
import qualified Data.ByteString.Char8 as B8
@ -18,16 +16,12 @@ 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.Communication
import Server.Game
import Server.Map (generateArena)
import Server.Types
@ -44,21 +38,8 @@ main = do
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
raiseSignal keyboardSignal
)
Nothing
sock <- bindSocket setSocketPath
dropSocketOnSigint sock
Net.listen sock 1024
putStrLn "Bound and listening to socket:"
print =<< getSocketName sock
@ -69,7 +50,7 @@ main = do
putStrLn "-----------------------------------------------------------------------------------"
putStrLn "starting game…"
now <- getCurrentTime
let initRead = ReaderContainer (arenaMap arena) setFPS
let initRead = ReaderContainer (arenaMap arena) setFPS sock
initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
(finalState, finalWrite) <- execRWST runGame initRead initState
print finalWrite
@ -79,9 +60,3 @@ main = do
<> 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

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 Network.Socket
import Options.Applicative as O
import Library.Types
@ -40,6 +42,7 @@ options = Options
data ReaderContainer = ReaderContainer
{ rcMap :: ServerMap
, rcFPS :: Int
, rcSocket :: Socket
}
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
import: warnings
main-is: Main.hs
other-modules: Server.Game
other-modules: Server.Communication
Server.Game
Server.Map
Server.Types
Server.Util
-- other-extensions:
build-depends: base ^>=4.17.2.1
, aeson