1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
\-}
{-# LANGUAGE RankNTypes #-}
module ConfigFile where
import Data.Maybe
import Data.TConfig
import qualified Data.ByteString.Char8 as B
-------------------
import CoreTypes
cfgFileName :: String
cfgFileName = "hedgewars-server.ini"
readServerConfig :: ServerInfo -> IO ServerInfo
readServerConfig serverInfo' = do
cfg <- readConfig cfgFileName
let si = serverInfo'{
dbHost = value "dbHost" cfg
, dbName = value "dbName" cfg
, dbLogin = value "dbLogin" cfg
, dbPassword = value "dbPassword" cfg
, serverMessage = value "sv_message" cfg
, serverMessageForOldVersions = value "sv_messageOld" cfg
, bans = read . fromJust2 "bans" $ getValue "bans" cfg
, latestReleaseVersion = read . fromJust $ getValue "sv_latestProto" cfg
, serverConfig = Just cfg
}
return si
where
value n c = B.pack . fromJust2 n $ getValue n c
fromJust2 n Nothing = error $ "Missing config entry " ++ n
fromJust2 _ (Just a) = a
writeServerConfig :: ServerInfo -> IO ()
writeServerConfig ServerInfo{serverConfig = Nothing} = return ()
writeServerConfig ServerInfo{
dbHost = dh,
dbName = dn,
dbLogin = dl,
dbPassword = dp,
serverMessage = sm,
serverMessageForOldVersions = smo,
bans = b,
latestReleaseVersion = ver,
serverConfig = Just cfg}
=
writeConfig cfgFileName $ foldl1 (.) entries cfg
where
entries =
repConfig "sv_latestProto" (show ver)
: repConfig "bans" (show b)
: map (\(n, v) -> repConfig n (B.unpack v)) [
("dbHost", dh)
, ("dbName", dn)
, ("dbLogin", dl)
, ("dbPassword", dp)
, ("sv_message", sm)
, ("sv_messageOld", smo)
]
|
