# HG changeset patch # User unc0rr # Date 1299609900 -10800 # Node ID 408301a9d2d612a06811033bb7676b523bd022fe # Parent 90d1fb9fc2e1c1dca6619042c0321dd72009b3a9 - Simplify insane TConfig code - Fix a bunch of warning diff -r 90d1fb9fc2e1 -r 408301a9d2d6 gameServer/ConfigFile.hs --- 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) diff -r 90d1fb9fc2e1 -r 408301a9d2d6 gameServer/Data/TConfig.hs --- 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 diff -r 90d1fb9fc2e1 -r 408301a9d2d6 gameServer/OfficialServer/DBInteraction.hs --- 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