gameServer/Opts.hs
changeset 4975 31da8979e5b1
parent 4957 3684faf5b3d1
child 4989 4771fed9272e
equal deleted inserted replaced
4974:078cd026a7b1 4975:31da8979e5b1
     9 import Data.Maybe ( fromMaybe )
     9 import Data.Maybe ( fromMaybe )
    10 -------------------
    10 -------------------
    11 import CoreTypes
    11 import CoreTypes
    12 import Utils
    12 import Utils
    13 
    13 
    14 options :: [OptDescr (ServerInfo -> ServerInfo)]
    14 options :: [OptDescr (ServerInfo c -> ServerInfo c)]
    15 options = [
    15 options = [
    16     Option "p" ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
    16     Option "p" ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
    17     Option "d" ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
    17     Option "d" ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
    18     ]
    18     ]
    19 
    19 
    20 readListenPort
    20 readListenPort
    21     , readDedicated
    21     , readDedicated
    22     :: String -> ServerInfo -> ServerInfo
    22     :: String -> ServerInfo c -> ServerInfo c
    23 
    23 
    24 
    24 
    25 readListenPort str opts = opts{listenPort = readPort}
    25 readListenPort str opts = opts{listenPort = readPort}
    26     where
    26     where
    27         readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
    27         readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
    28 
    28 
    29 readDedicated str opts = opts{isDedicated = readDed}
    29 readDedicated str opts = opts{isDedicated = readDed}
    30     where
    30     where
    31         readDed = fromMaybe True (maybeRead str :: Maybe Bool)
    31         readDed = fromMaybe True (maybeRead str :: Maybe Bool)
    32 
    32 
    33 getOpts :: ServerInfo -> IO ServerInfo
    33 getOpts :: ServerInfo c -> IO (ServerInfo c)
    34 getOpts opts = do
    34 getOpts opts = do
    35     args <- getArgs
    35     args <- getArgs
    36     case getOpt Permute options args of
    36     case getOpt Permute options args of
    37         (o, [], []) -> return $ foldr ($) opts o
    37         (o, [], []) -> return $ foldr ($) opts o
    38         (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
    38         (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))