10 import CoreTypes |
10 import CoreTypes |
11 import Utils |
11 import Utils |
12 |
12 |
13 options :: [OptDescr (ServerInfo -> ServerInfo)] |
13 options :: [OptDescr (ServerInfo -> ServerInfo)] |
14 options = [ |
14 options = [ |
15 Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT", |
15 Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT", |
16 Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)" |
16 Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)" |
17 ] |
17 ] |
18 |
18 |
19 readListenPort, |
19 readListenPort, |
20 readDedicated, |
20 readDedicated, |
21 readDbLogin, |
21 readDbLogin, |
22 readDbPassword, |
22 readDbPassword, |
23 readDbHost :: String -> ServerInfo -> ServerInfo |
23 readDbHost :: String -> ServerInfo -> ServerInfo |
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 = readDedicated} |
29 readDedicated str opts = opts{isDedicated = readDedicated} |
30 where |
30 where |
31 readDedicated = fromMaybe True (maybeRead str :: Maybe Bool) |
31 readDedicated = fromMaybe True (maybeRead str :: Maybe Bool) |
32 |
32 |
33 readDbLogin str opts = opts{dbLogin = str} |
33 readDbLogin str opts = opts{dbLogin = str} |
34 readDbPassword str opts = opts{dbPassword = str} |
34 readDbPassword str opts = opts{dbPassword = str} |
35 readDbHost str opts = opts{dbHost = str} |
35 readDbHost str opts = opts{dbHost = str} |
36 |
36 |
37 getOpts :: ServerInfo -> IO ServerInfo |
37 getOpts :: ServerInfo -> IO ServerInfo |
38 getOpts opts = do |
38 getOpts opts = do |
39 args <- getArgs |
39 args <- getArgs |
40 case getOpt Permute options args of |
40 case getOpt Permute options args of |
41 (o, [], []) -> return $ foldr ($) opts o |
41 (o, [], []) -> return $ foldr ($) opts o |
42 (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) |
42 (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) |
43 where header = "Usage: newhwserv [OPTION...]" |
43 where header = "Usage: newhwserv [OPTION...]" |