gameServer/Opts.hs
author nemo
Sun, 24 Jan 2010 16:46:06 +0000
changeset 2712 8f4527c9137c
parent 1964 dc9ea05c9d2f
child 2867 9be6693c78cb
permissions -rw-r--r--
Minor tweak, try to make long flavour text last longer, move the hurt self messages to unused messages group, so they don't get wiped by crate an instant later.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
(
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
	getOpts,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
) where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import System.Console.GetOpt
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Data.Maybe ( fromMaybe )
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
options :: [OptDescr (ServerInfo -> ServerInfo)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
options = [
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
	Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1832
diff changeset
    16
	Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
	]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    19
readListenPort,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    20
	readDedicated,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    21
	readDbLogin,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    22
	readDbPassword,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    23
	readDbHost :: String -> ServerInfo -> ServerInfo
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    24
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
readListenPort str opts = opts{listenPort = readPort}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
		readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
readDedicated str opts = opts{isDedicated = readDedicated}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
		readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    33
readDbLogin str opts = opts{dbLogin = str}
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    34
readDbPassword str opts = opts{dbPassword = str}
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    35
readDbHost str opts = opts{dbHost = str}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
getOpts :: ServerInfo -> IO ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
getOpts opts = do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
	args <- getArgs
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	case getOpt Permute options args of
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
		(o, [], []) -> return $ foldr ($) opts o
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
		(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
	where header = "Usage: newhwserv [OPTION...]"