gameServer/ConfigFile.hs
author Marco Bresciani
Fri, 12 Jul 2013 11:57:31 +0200
changeset 9355 48549227aa2b
parent 8401 87410ae372f6
child 10460 8dcea9087d75
permissions -rw-r--r--
Many modifications (these files seems written by a non Italian): 1. some (not all, yet) of the typos! 2. Italian grammar is different from English: there are no "Titles Like This" but "Titles like this" if there are no proper nouns. 3. Let's use actual Italian words not "Engrish" or jargon. For example, "chatta" to say "to chat" is not correct even if widely used! 4. I'd use the Italian "Morte improvvisa" instead of English "Sudden Death"; what to do you think?

{-# 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)
            ]