author | unc0rr |
Mon, 07 Oct 2013 22:22:49 +0400 | |
changeset 9493 | 23c674bfa2e2 |
parent 8401 | 87410ae372f6 |
child 10460 | 8dcea9087d75 |
permissions | -rw-r--r-- |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
1 |
{-# LANGUAGE RankNTypes #-} |
4974
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
2 |
module ConfigFile where |
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
3 |
|
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
4 |
import Data.Maybe |
4974
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
5 |
import Data.TConfig |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
6 |
import qualified Data.ByteString.Char8 as B |
4974
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
7 |
------------------- |
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
8 |
import CoreTypes |
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
9 |
|
4992 | 10 |
cfgFileName :: String |
4989 | 11 |
cfgFileName = "hedgewars-server.ini" |
12 |
||
4992 | 13 |
|
14 |
readServerConfig :: ServerInfo -> IO ServerInfo |
|
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
15 |
readServerConfig serverInfo' = do |
4989 | 16 |
cfg <- readConfig cfgFileName |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
17 |
let si = serverInfo'{ |
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
18 |
dbHost = value "dbHost" cfg |
4982
3572eaf14340
Add dbName parameter to .ini file, fix some warnings
unc0rr
parents:
4975
diff
changeset
|
19 |
, dbName = value "dbName" cfg |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
20 |
, dbLogin = value "dbLogin" cfg |
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
21 |
, dbPassword = value "dbPassword" cfg |
4988 | 22 |
, serverMessage = value "sv_message" cfg |
23 |
, serverMessageForOldVersions = value "sv_messageOld" cfg |
|
5009 | 24 |
, bans = read . fromJust2 "bans" $ getValue "bans" cfg |
4988 | 25 |
, latestReleaseVersion = read . fromJust $ getValue "sv_latestProto" cfg |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
26 |
, serverConfig = Just cfg |
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
27 |
} |
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
28 |
return si |
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4974
diff
changeset
|
29 |
where |
4988 | 30 |
value n c = B.pack . fromJust2 n $ getValue n c |
31 |
fromJust2 n Nothing = error $ "Missing config entry " ++ n |
|
32 |
fromJust2 _ (Just a) = a |
|
4974
078cd026a7b1
Add stubs for server config reading and writing routines
unc0rr
parents:
diff
changeset
|
33 |
|
4989 | 34 |
|
4992 | 35 |
writeServerConfig :: ServerInfo -> IO () |
4989 | 36 |
writeServerConfig ServerInfo{serverConfig = Nothing} = return () |
37 |
writeServerConfig ServerInfo{ |
|
38 |
dbHost = dh, |
|
39 |
dbName = dn, |
|
40 |
dbLogin = dl, |
|
41 |
dbPassword = dp, |
|
42 |
serverMessage = sm, |
|
43 |
serverMessageForOldVersions = smo, |
|
5009 | 44 |
bans = b, |
4989 | 45 |
latestReleaseVersion = ver, |
46 |
serverConfig = Just cfg} |
|
5009 | 47 |
= |
48 |
writeConfig cfgFileName $ foldl1 (.) entries cfg |
|
4989 | 49 |
where |
5009 | 50 |
entries = |
51 |
repConfig "sv_latestProto" (show ver) |
|
52 |
: repConfig "bans" (show b) |
|
53 |
: map (\(n, v) -> repConfig n (B.unpack v)) [ |
|
4989 | 54 |
("dbHost", dh) |
55 |
, ("dbName", dn) |
|
56 |
, ("dbLogin", dl) |
|
57 |
, ("dbPassword", dp) |
|
58 |
, ("sv_message", sm) |
|
59 |
, ("sv_messageOld", smo) |
|
60 |
] |