netserver/Opts.hs
changeset 1383 d20e6e8928e3
parent 1342 ae6c4f10ace2
child 1386 674429128152
equal deleted inserted replaced
1382:b6ab9fea22fe 1383:d20e6e8928e3
     3 import System
     3 import System
     4 import System.Console.GetOpt
     4 import System.Console.GetOpt
     5 import Network
     5 import Network
     6 import Data.Maybe ( fromMaybe )
     6 import Data.Maybe ( fromMaybe )
     7 import Miscutils
     7 import Miscutils
       
     8 import System.IO.Unsafe
     8 
     9 
     9 data Flag = ListenPort PortNumber
    10 data GlobalOptions =
    10 	deriving Show
    11 	GlobalOptions
       
    12 	{
       
    13 		isDedicated :: Bool,
       
    14 		serverMessage :: String,
       
    15 		listenPort :: PortNumber
       
    16 	}
       
    17 defaultMessage = "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
       
    18 defaultOptions = (GlobalOptions False defaultMessage 46631)
    11 
    19 
    12 options :: [OptDescr Flag]
    20 options :: [OptDescr (GlobalOptions -> GlobalOptions)]
    13 options = [
    21 options = [
    14 	Option ['p'] ["port"] (OptArg readPort "PORT") "listen on PORT"
    22 	Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
       
    23 	Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
    15 	]
    24 	]
    16 
    25 
    17 readPort :: Maybe String -> Flag
    26 readListenPort, readDedicated :: String -> GlobalOptions -> GlobalOptions
    18 readPort str = ListenPort $ fromInteger (fromMaybe 46631 (maybeRead (fromMaybe "46631" str) :: Maybe Integer))
    27 readListenPort str opts = opts{listenPort = readPort}
       
    28 	where
       
    29 		readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
    19 
    30 
    20 opts :: IO [Flag]
    31 readDedicated str opts = opts{isDedicated = readDedicated}
       
    32 	where
       
    33 		readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
       
    34 
       
    35 opts :: IO GlobalOptions
    21 opts = do
    36 opts = do
    22 	args <- getArgs
    37 	args <- getArgs
    23 	case getOpt Permute options args of
    38 	case getOpt Permute options args of
    24 		(o, [], []) -> return o
    39 		(o, [], []) -> return $ foldr ($) defaultOptions o
    25 		(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
    40 		(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
    26 	where header = "Usage: newhwserv [OPTION...]"
    41 	where header = "Usage: newhwserv [OPTION...]"
    27 
    42 
    28 getPort :: [Flag] -> PortNumber
    43 {-# NOINLINE globalOptions #-}
    29 getPort [] = 46631
    44 globalOptions = unsafePerformIO opts
    30 getPort (ListenPort a:flags) = a