gameServer/Opts.hs
author sheepluva
Sun, 06 Feb 2011 11:39:11 +0100
changeset 4929 3dca560e6510
parent 4905 7842d085acf4
child 4932 f11d80bac7ed
permissions -rw-r--r--
I need this export in order to not have the wrapper.c fail to find Game() on linux From this point on compilation and usage of library should work on linux, at least does for me :P
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
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     6
import System.Environment
1804
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 )
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    10
import qualified Data.ByteString.Char8 as B
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    11
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
options :: [OptDescr (ServerInfo -> ServerInfo)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
options = [
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    17
    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
    18
    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
    19
    ]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    21
readListenPort,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    22
    readDedicated,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    23
    readDbLogin,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    24
    readDbPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    25
    readDbHost :: String -> ServerInfo -> ServerInfo
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    26
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
readListenPort str opts = opts{listenPort = readPort}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    28
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    29
        readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
readDedicated str opts = opts{isDedicated = readDedicated}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    32
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    33
        readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    35
readDbLogin str opts = opts{dbLogin = B.pack str}
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    36
readDbPassword str opts = opts{dbPassword = B.pack str}
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    37
readDbHost str opts = opts{dbHost = B.pack str}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
getOpts :: ServerInfo -> IO ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
getOpts opts = do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    41
    args <- getArgs
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    42
    case getOpt Permute options args of
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    43
        (o, [], []) -> return $ foldr ($) opts o
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    44
        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
2966
fab0d8b04bb9 Server:
smxx
parents: 2867
diff changeset
    45
    where header = "Usage: hedgewars-server [OPTION...]"