- Simplify insane TConfig code
authorunc0rr
Tue, 08 Mar 2011 21:45:00 +0300
changeset 4992 408301a9d2d6
parent 4991 90d1fb9fc2e1
child 4993 905b349af377
- Simplify insane TConfig code - Fix a bunch of warning
gameServer/ConfigFile.hs
gameServer/Data/TConfig.hs
gameServer/OfficialServer/DBInteraction.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)
--- 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