1804
|
1 |
module Opts
|
|
2 |
(
|
|
3 |
getOpts,
|
|
4 |
) where
|
|
5 |
|
|
6 |
import System
|
|
7 |
import System.Console.GetOpt
|
|
8 |
import Network
|
|
9 |
import Data.Maybe ( fromMaybe )
|
|
10 |
import CoreTypes
|
|
11 |
import Utils
|
|
12 |
|
|
13 |
options :: [OptDescr (ServerInfo -> ServerInfo)]
|
|
14 |
options = [
|
|
15 |
Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
|
|
16 |
Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)",
|
1832
|
17 |
Option [] ["db-login"] (ReqArg readDbLogin "STRING") "database access login",
|
|
18 |
Option [] ["db-password"] (ReqArg readDbPassword "STRING") "database access password",
|
|
19 |
Option [] ["db-host"] (ReqArg readDbHost "STRING") "database host"
|
1804
|
20 |
]
|
|
21 |
|
1832
|
22 |
readListenPort,
|
|
23 |
readDedicated,
|
|
24 |
readDbLogin,
|
|
25 |
readDbPassword,
|
|
26 |
readDbHost :: String -> ServerInfo -> ServerInfo
|
|
27 |
|
1804
|
28 |
readListenPort str opts = opts{listenPort = readPort}
|
|
29 |
where
|
|
30 |
readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
|
|
31 |
|
|
32 |
readDedicated str opts = opts{isDedicated = readDedicated}
|
|
33 |
where
|
|
34 |
readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
|
|
35 |
|
1832
|
36 |
readDbLogin str opts = opts{dbLogin = str}
|
|
37 |
readDbPassword str opts = opts{dbPassword = str}
|
|
38 |
readDbHost str opts = opts{dbHost = str}
|
1804
|
39 |
|
|
40 |
getOpts :: ServerInfo -> IO ServerInfo
|
|
41 |
getOpts opts = do
|
|
42 |
args <- getArgs
|
|
43 |
case getOpt Permute options args of
|
|
44 |
(o, [], []) -> return $ foldr ($) opts o
|
|
45 |
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
|
|
46 |
where header = "Usage: newhwserv [OPTION...]"
|