gameServer/Data/TConfig.hs
changeset 4989 4771fed9272e
child 4992 408301a9d2d6
--- /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)