gameServer/Opts.hs
author koda
Sat, 05 Jun 2010 14:07:58 +0000
changeset 3495 a6b4f351d400
parent 2966 fab0d8b04bb9
child 3500 af8390d807d6
permissions -rw-r--r--
now engine can be optionally built as library, there's an example wrapper of how to use it building server is now disabled by default, saves users some headaches
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
(
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
     3
    getOpts,
1804
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 = [
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    15
    Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    16
    Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    17
    ]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    19
readListenPort,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    20
    readDedicated,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    21
    readDbLogin,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    22
    readDbPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    23
    readDbHost :: String -> ServerInfo -> ServerInfo
1832
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}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    26
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    27
        readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
readDedicated str opts = opts{isDedicated = readDedicated}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    30
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    31
        readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
1804
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
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    39
    args <- getArgs
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    40
    case getOpt Permute options args of
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    41
        (o, [], []) -> return $ foldr ($) opts o
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    42
        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
2966
fab0d8b04bb9 Server:
smxx
parents: 2867
diff changeset
    43
    where header = "Usage: hedgewars-server [OPTION...]"