gameServer/ConfigFile.hs
author unc0rr
Sun, 06 Mar 2011 21:55:44 +0300
changeset 4990 4b5d62ac01f7
parent 4989 4771fed9272e
child 4992 408301a9d2d6
permissions -rw-r--r--
Write latest protocol version too

{-# LANGUAGE RankNTypes #-}
module ConfigFile where

import Data.Maybe
import Data.TConfig
import qualified Data.ByteString.Char8 as B
-------------------
import CoreTypes

cfgFileName = "hedgewars-server.ini"

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
        , 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{serverConfig = Nothing} = return ()
writeServerConfig ServerInfo{
    dbHost = dh,
    dbName = dn,
    dbLogin = dl,
    dbPassword = dp,
    serverMessage = sm,
    serverMessageForOldVersions = smo,
    latestReleaseVersion = ver,
    serverConfig = Just cfg}
        = do
    let newCfg = foldl (\c (n, v) -> repConfig n (B.unpack v) c) cfg entries
    writeConfig cfgFileName (repConfig "sv_latestProto" (show ver) cfg)
    where
        entries = [
            ("dbHost", dh)
            , ("dbName", dn)
            , ("dbLogin", dl)
            , ("dbPassword", dp)
            , ("sv_message", sm)
            , ("sv_messageOld", smo)
            ]