# HG changeset patch
# User unc0rr
# Date 1299437677 -10800
# Node ID 4771fed9272ef1e59a394bb7332537fa0ebb2784
# Parent  bd540ba665999183ba929ba5e33448e23ead4ab6
 - Write server config into .ini file on change
 - Import Data.TConfig into project, make it export Conf constructor, remove all workarounds for missing constructor in server.

diff -r bd540ba66599 -r 4771fed9272e gameServer/Actions.hs
--- a/gameServer/Actions.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/Actions.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -21,8 +21,9 @@
 import ClientIO
 import ServerState
 import Consts
+import ConfigFile
 
-data Action c =
+data Action =
     AnswerClients ![ClientChan] ![B.ByteString]
     | SendServerMessage
     | SendServerVars
@@ -44,7 +45,7 @@
     | ModifyClient (ClientInfo -> ClientInfo)
     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
     | ModifyRoom (RoomInfo -> RoomInfo)
-    | ModifyServerInfo (ServerInfo c -> ServerInfo c)
+    | ModifyServerInfo (ServerInfo -> ServerInfo)
     | AddRoom B.ByteString B.ByteString
     | CheckRegistered
     | ClearAccountsCache
@@ -56,9 +57,9 @@
     | RestartServer Bool
 
 
-type CmdHandler c = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action c]
+type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 
-instance NFData (Action c) where
+instance NFData Action where
     rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
     rnf a = a `seq` ()
 
@@ -66,13 +67,13 @@
 instance NFData (Chan a)
 
 
-othersChans :: StateT (ServerState c) IO [ClientChan]
+othersChans :: StateT ServerState IO [ClientChan]
 othersChans = do
     cl <- client's id
     ri <- clientRoomA
     liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
 
-processAction :: Action c -> StateT (ServerState c) IO ()
+processAction :: Action -> StateT ServerState IO ()
 
 
 processAction (AnswerClients chans msg) =
@@ -162,8 +163,10 @@
     return ()
 
 
-processAction (ModifyServerInfo f) =
+processAction (ModifyServerInfo f) = do
     modify (\s -> s{serverInfo = f $ serverInfo s})
+    si <- gets serverInfo
+    io $ writeServerConfig si
 
 
 processAction (MoveToRoom ri) = do
diff -r bd540ba66599 -r 4771fed9272e gameServer/ConfigFile.hs
--- a/gameServer/ConfigFile.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/ConfigFile.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -7,8 +7,10 @@
 -------------------
 import CoreTypes
 
+cfgFileName = "hedgewars-server.ini"
+
 readServerConfig serverInfo' = do
-    cfg <- readConfig "hedgewars-server.ini"
+    cfg <- readConfig cfgFileName
     let si = serverInfo'{
         dbHost = value "dbHost" cfg
         , dbName = value "dbName" cfg
@@ -25,5 +27,26 @@
         fromJust2 n Nothing = error $ "Missing config entry " ++ n
         fromJust2 _ (Just a) = a
 
-writeServerConfig :: ServerInfo c -> IO ()
-writeServerConfig = undefined
+
+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 newCfg
+    where
+        entries = [
+            ("dbHost", dh)
+            , ("dbName", dn)
+            , ("dbLogin", dl)
+            , ("dbPassword", dp)
+            , ("sv_message", sm)
+            , ("sv_messageOld", smo)
+            ]
diff -r bd540ba66599 -r 4771fed9272e gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/CoreTypes.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -12,6 +12,7 @@
 import Data.Unique
 import Control.Exception
 import Data.Typeable
+import Data.TConfig
 -----------------------
 import RoomsAndClients
 
@@ -123,7 +124,7 @@
         roomsNumber :: Int
     }
 
-data ServerInfo c =
+data ServerInfo =
     ServerInfo
     {
         isDedicated :: Bool,
@@ -141,13 +142,13 @@
         restartPending :: Bool,
         coreChan :: Chan CoreMessage,
         dbQueries :: Chan DBQuery,
-        serverConfig :: Maybe c
+        serverConfig :: Maybe Conf
     }
 
-instance Show (ServerInfo c) where
+instance Show ServerInfo where
     show _ = "Server Info"
 
-newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe c -> ServerInfo c
+newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Conf -> ServerInfo
 newServerInfo =
     ServerInfo
         True
diff -r bd540ba66599 -r 4771fed9272e gameServer/Data/TConfig.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/Data/TConfig.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -0,0 +1,116 @@
+-- Module      : Data.TConfig
+-- Copyright   : (c) Anthony Simpson 2009
+-- License     : BSD3
+--
+-- Maintainer  : DiscipleRayne@gmail.com
+-- Stability   : relatively stable
+-- Portability : portable
+---------------------------------------------------
+{-|
+  A small and simple text file configuration
+  library written in Haskell. It is similar
+  to the INI file format, but lacks a few of
+  it's features, such as sections. It is
+  suitable for simple games that need to
+  keep track of certain information between
+  plays.
+-}
+module Data.TConfig
+    (
+     getValue
+   , repConfig
+   , readConfig
+   , writeConfig
+   , remKey
+   , addKey
+   , Conf ()
+   ) where
+
+import Data.Char
+import qualified Data.Map as M
+
+type Key   = String
+type Value = String
+type Conf  = M.Map Key Value
+
+-- |Adds a key and value to the end of the configuration.
+addKey :: Key -> Value -> Conf -> Conf
+addKey k v conf = M.insert k (addQuotes v) conf
+
+-- |Utility Function. Checks for the existence
+-- of a key.
+checkKey :: Key -> Conf -> Bool
+checkKey k conf = M.member k conf
+
+-- |Utility function.
+-- Removes a key and it's value from the configuration.
+remKey :: Key -> Conf -> Conf
+remKey k conf = M.delete k conf
+
+-- |Utility function. Searches a configuration for a
+-- key, and returns it's value.
+getValue :: Key -> Conf -> Maybe Value
+getValue k conf = case M.lookup k conf of
+                    Just val -> Just $ stripQuotes val
+                    Nothing  -> Nothing
+
+stripQuotes :: String -> String
+stripQuotes x | any isSpace x = filter (/= '\"') x
+              | otherwise     = x
+
+-- |Returns a String wrapped in quotes if it
+-- contains spaces, otherwise returns the string
+-- untouched.
+addQuotes :: String -> String
+addQuotes x | any isSpace x = "\"" ++ x ++ "\""
+            | otherwise     = x
+
+-- |Utility function. Replaces the value
+-- associated with a key in a configuration.
+repConfig :: Key -> Value -> Conf -> Conf
+repConfig k rv conf = let f _ = Just rv
+                      in M.alter f k conf
+
+-- |Reads a file and parses to a Map String String.
+readConfig :: FilePath -> IO Conf
+readConfig path = readFile path >>= return . parseConfig
+
+-- |Parses a parsed configuration back to a file.
+writeConfig :: FilePath -> Conf -> IO ()
+writeConfig path con = writeFile path $ putTogether con
+
+-- |Turns a list of configuration types back into a String
+-- to write to a file.
+putTogether :: Conf -> String
+putTogether = concat . putTogether' . backToString
+    where putTogether' (x:y:xs) = x : " = " : y : "\n" : putTogether' xs
+          putTogether' _        = []
+
+-- |Turns a list of configuration types into a list of Strings
+backToString :: Conf -> [String]
+backToString conf = backToString' $ M.toList conf
+    where backToString' ((x,y):xs) = x : y : backToString' xs
+          backToString' _          = []
+
+-- |Parses a string into a list of Configuration types.
+parseConfig :: String -> Conf
+parseConfig = listConfig . popString . parse
+
+parse :: String -> [String]
+parse = words . filter (/= '=')
+
+-- |Turns a list of key value key value etc... pairs into
+-- A list of Configuration types.
+listConfig :: [String] -> Conf
+listConfig = M.fromList . helper
+    where helper (x:y:xs) = (x,y) : helper xs
+          helper _        = []
+
+-- |Parses strings from the parseConfig'd file.
+popString :: [String] -> [String]
+popString []     = []
+popString (x:xs)
+    | head x == '\"' = findClose $ break (('\"' ==) . last) xs
+    | otherwise      = x : popString xs
+    where findClose (y,ys) =
+              [unwords $ x : y ++ [head ys]] ++ popString (tail ys)
diff -r bd540ba66599 -r 4771fed9272e gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/HWProtoCore.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -14,7 +14,7 @@
 import RoomsAndClients
 import Utils
 
-handleCmd, handleCmd_loggedin :: CmdHandler c
+handleCmd, handleCmd_loggedin :: CmdHandler
 
 
 handleCmd ["PING"] = answerClient ["PONG"]
diff -r bd540ba66599 -r 4771fed9272e gameServer/HWProtoInRoomState.hs
--- a/gameServer/HWProtoInRoomState.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/HWProtoInRoomState.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -15,7 +15,7 @@
 import HandlerUtils
 import RoomsAndClients
 
-handleCmd_inRoom :: CmdHandler c
+handleCmd_inRoom :: CmdHandler
 
 handleCmd_inRoom ["CHAT", msg] = do
     n <- clientNick
@@ -99,8 +99,8 @@
                 ModifyClient
                     (\c -> c{
                         teamsInGame = teamsInGame c - 1,
-                            clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci r
-                        })
+                        clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci r
+                    })
                 ]
     where
         anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
diff -r bd540ba66599 -r 4771fed9272e gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -15,7 +15,7 @@
 import RoomsAndClients
 
 
-answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action c]
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
 answerAllTeams cl = concatMap toAnswer
     where
         clChan = sendChan cl
@@ -24,7 +24,7 @@
             AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
             AnswerClients [clChan] ["HH_NUM", teamname team, B.pack . show $ hhnum team]]
 
-handleCmd_lobby :: CmdHandler c
+handleCmd_lobby :: CmdHandler
 
 
 handleCmd_lobby ["LIST"] = do
diff -r bd540ba66599 -r 4771fed9272e gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/HWProtoNEState.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -11,7 +11,7 @@
 import Utils
 import RoomsAndClients
 
-handleCmd_NotEntered :: CmdHandler c
+handleCmd_NotEntered :: CmdHandler
 
 handleCmd_NotEntered ["NICK", newNick] = do
     (ci, irnc) <- ask
diff -r bd540ba66599 -r 4771fed9272e gameServer/HandlerUtils.hs
--- a/gameServer/HandlerUtils.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/HandlerUtils.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -48,7 +48,7 @@
     (ci, rnc) <- ask
     return [sendChan (rnc `client` ci)]
 
-answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action c]
+answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
 
 allRoomInfos :: Reader (a, IRnC) [RoomInfo]
diff -r bd540ba66599 -r 4771fed9272e gameServer/OfficialServer/DBInteraction.hs
--- a/gameServer/OfficialServer/DBInteraction.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -27,7 +27,7 @@
 localAddressList :: [B.ByteString]
 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
 
-fakeDbConnection :: forall b c. ServerInfo c -> IO b
+fakeDbConnection :: forall b. ServerInfo -> IO b
 fakeDbConnection si = forever $ do
     q <- readChan $ dbQueries si
     case q of
@@ -38,7 +38,7 @@
 
 --dbConnectionLoop :: forall b. (ServerInfo c) -> IO b
 #if defined(OFFICIAL_SERVER)
-flushRequests :: (ServerInfo c) -> IO ()
+flushRequests :: ServerInfo -> IO ()
 flushRequests si = do
     e <- isEmptyChan $ dbQueries si
     unless e $ do
@@ -89,10 +89,10 @@
         maybeException (Just a) = return a
         maybeException Nothing = ioError (userError "Can't read")
 
-pipeDbConnection :: forall a c b.
+pipeDbConnection :: forall a b.
         (Num a, Ord a) =>
         Map.Map ByteString (UTCTime, AccountInfo)
-        -> ServerInfo c
+        -> ServerInfo
         -> a
         -> IO b
 
@@ -116,7 +116,7 @@
     threadDelay (3000000)
     pipeDbConnection updatedCache si newErrNum
 
-dbConnectionLoop :: forall c b. ServerInfo c -> IO b
+dbConnectionLoop :: forall b. ServerInfo -> IO b
 dbConnectionLoop si =
         if (not . B.null $ dbHost si) then
             pipeDbConnection Map.empty si 0
@@ -126,6 +126,6 @@
 dbConnectionLoop = fakeDbConnection
 #endif
 
-startDBConnection :: (ServerInfo c) -> IO ()
+startDBConnection :: ServerInfo -> IO ()
 startDBConnection serverInfo =
     forkIO (dbConnectionLoop serverInfo) >> return ()
diff -r bd540ba66599 -r 4771fed9272e gameServer/Opts.hs
--- a/gameServer/Opts.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/Opts.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -11,7 +11,7 @@
 import CoreTypes
 import Utils
 
-options :: [OptDescr (ServerInfo c -> ServerInfo c)]
+options :: [OptDescr (ServerInfo -> ServerInfo)]
 options = [
     Option "p" ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
     Option "d" ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
@@ -19,7 +19,7 @@
 
 readListenPort
     , readDedicated
-    :: String -> ServerInfo c -> ServerInfo c
+    :: String -> ServerInfo -> ServerInfo
 
 
 readListenPort str opts = opts{listenPort = readPort}
@@ -30,7 +30,7 @@
     where
         readDed = fromMaybe True (maybeRead str :: Maybe Bool)
 
-getOpts :: ServerInfo c -> IO (ServerInfo c)
+getOpts :: ServerInfo -> IO ServerInfo
 getOpts opts = do
     args <- getArgs
     case getOpt Permute options args of
diff -r bd540ba66599 -r 4771fed9272e gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/ServerCore.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -23,14 +23,14 @@
 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-reactCmd :: [B.ByteString] -> StateT (ServerState c) IO ()
+reactCmd :: [B.ByteString] -> StateT ServerState IO ()
 reactCmd cmd = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
     forM_ (actions `deepseq` actions) processAction
 
-mainLoop :: StateT (ServerState c) IO ()
+mainLoop :: StateT ServerState IO ()
 mainLoop = forever $ do
     -- get >>= \s -> put $! s
 
@@ -68,7 +68,7 @@
                     PingAll : [StatsAction | even tick]
 
 
-startServer :: ServerInfo c -> Socket -> IO ()
+startServer :: ServerInfo -> Socket -> IO ()
 startServer si serverSocket = do
     putStrLn $ "Listening on port " ++ show (listenPort si)
 
diff -r bd540ba66599 -r 4771fed9272e gameServer/ServerState.hs
--- a/gameServer/ServerState.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/ServerState.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -15,33 +15,33 @@
 import RoomsAndClients
 import CoreTypes
 
-data ServerState c = ServerState {
+data ServerState = ServerState {
         clientIndex :: !(Maybe ClientIndex),
-        serverInfo :: !(ServerInfo c),
+        serverInfo :: !ServerInfo,
         removedClients :: !(Set.Set ClientIndex),
         roomsClients :: !MRnC
     }
 
 
-clientRoomA :: StateT (ServerState c) IO RoomIndex
+clientRoomA :: StateT ServerState IO RoomIndex
 clientRoomA = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     io $ clientRoomM rnc ci
 
-client's :: (ClientInfo -> a) -> StateT (ServerState c) IO a
+client's :: (ClientInfo -> a) -> StateT ServerState IO a
 client's f = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     io $ client'sM rnc f ci
 
-allClientsS :: StateT (ServerState c) IO [ClientInfo]
+allClientsS :: StateT ServerState IO [ClientInfo]
 allClientsS = gets roomsClients >>= liftIO . clientsM
 
-roomClientsS :: RoomIndex -> StateT (ServerState c) IO [ClientInfo]
+roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
 roomClientsS ri = do
     rnc <- gets roomsClients
     io $ roomClientsM rnc ri
 
-io :: IO a -> StateT (ServerState c) IO a
+io :: IO a -> StateT ServerState IO a
 io = liftIO
diff -r bd540ba66599 -r 4771fed9272e gameServer/hedgewars-server.hs
--- a/gameServer/hedgewars-server.hs	Sat Mar 05 22:39:26 2011 +0300
+++ b/gameServer/hedgewars-server.hs	Sun Mar 06 21:54:37 2011 +0300
@@ -25,7 +25,7 @@
         (setLevel INFO)
 
 
-server :: ServerInfo c -> IO ()
+server :: ServerInfo -> IO ()
 server si = do
     proto <- getProtocolNumber "tcp"
     E.bracket