--- a/gameServer/ConfigFile.hs Tue Mar 08 21:27:44 2011 +0300
+++ b/gameServer/ConfigFile.hs Tue Mar 08 21:45:00 2011 +0300
@@ -7,8 +7,11 @@
-------------------
import CoreTypes
+cfgFileName :: String
cfgFileName = "hedgewars-server.ini"
+
+readServerConfig :: ServerInfo -> IO ServerInfo
readServerConfig serverInfo' = do
cfg <- readConfig cfgFileName
let si = serverInfo'{
@@ -28,6 +31,7 @@
fromJust2 _ (Just a) = a
+writeServerConfig :: ServerInfo -> IO ()
writeServerConfig ServerInfo{serverConfig = Nothing} = return ()
writeServerConfig ServerInfo{
dbHost = dh,
@@ -40,7 +44,7 @@
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)
+ writeConfig cfgFileName (repConfig "sv_latestProto" (show ver) newCfg)
where
entries = [
("dbHost", dh)
--- a/gameServer/Data/TConfig.hs Tue Mar 08 21:27:44 2011 +0300
+++ b/gameServer/Data/TConfig.hs Tue Mar 08 21:45:00 2011 +0300
@@ -28,6 +28,7 @@
import Data.Char
import qualified Data.Map as M
+import Control.Monad
type Key = String
type Value = String
@@ -35,35 +36,17 @@
-- |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
+addKey = M.insert
-- |Utility function.
-- Removes a key and it's value from the configuration.
remKey :: Key -> Conf -> Conf
-remKey k conf = M.delete k conf
+remKey = M.delete
-- |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
+getValue = M.lookup
-- |Utility function. Replaces the value
-- associated with a key in a configuration.
@@ -73,44 +56,8 @@
-- |Reads a file and parses to a Map String String.
readConfig :: FilePath -> IO Conf
-readConfig path = readFile path >>= return . parseConfig
+readConfig path = liftM (M.fromList . map ((\(a, b) -> (filter (not . isSpace) a, dropWhile isSpace b)) . break (== '=')) . filter (not . null) . lines) $ readFile path
-- |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)
+writeConfig path = writeFile path . unlines . map (\(a, b) -> a ++ " = " ++ b) . M.toList
--- a/gameServer/OfficialServer/DBInteraction.hs Tue Mar 08 21:27:44 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs Tue Mar 08 21:45:00 2011 +0300
@@ -89,12 +89,11 @@
maybeException (Just a) = return a
maybeException Nothing = ioError (userError "Can't read")
-pipeDbConnection :: forall a b.
- (Num a, Ord a) =>
+pipeDbConnection ::
Map.Map ByteString (UTCTime, AccountInfo)
-> ServerInfo
- -> a
- -> IO b
+ -> Int
+ -> IO ()
pipeDbConnection accountsCache si errNum = do
(updatedCache, newErrNum) <-
@@ -116,7 +115,7 @@
threadDelay (3000000)
pipeDbConnection updatedCache si newErrNum
-dbConnectionLoop :: forall b. ServerInfo -> IO b
+dbConnectionLoop :: ServerInfo -> IO ()
dbConnectionLoop si =
if (not . B.null $ dbHost si) then
pipeDbConnection Map.empty si 0