26 , Conf () |
26 , Conf () |
27 ) where |
27 ) where |
28 |
28 |
29 import Data.Char |
29 import Data.Char |
30 import qualified Data.Map as M |
30 import qualified Data.Map as M |
|
31 import Control.Monad |
31 |
32 |
32 type Key = String |
33 type Key = String |
33 type Value = String |
34 type Value = String |
34 type Conf = M.Map Key Value |
35 type Conf = M.Map Key Value |
35 |
36 |
36 -- |Adds a key and value to the end of the configuration. |
37 -- |Adds a key and value to the end of the configuration. |
37 addKey :: Key -> Value -> Conf -> Conf |
38 addKey :: Key -> Value -> Conf -> Conf |
38 addKey k v conf = M.insert k (addQuotes v) conf |
39 addKey = M.insert |
39 |
|
40 -- |Utility Function. Checks for the existence |
|
41 -- of a key. |
|
42 checkKey :: Key -> Conf -> Bool |
|
43 checkKey k conf = M.member k conf |
|
44 |
40 |
45 -- |Utility function. |
41 -- |Utility function. |
46 -- Removes a key and it's value from the configuration. |
42 -- Removes a key and it's value from the configuration. |
47 remKey :: Key -> Conf -> Conf |
43 remKey :: Key -> Conf -> Conf |
48 remKey k conf = M.delete k conf |
44 remKey = M.delete |
49 |
45 |
50 -- |Utility function. Searches a configuration for a |
46 -- |Utility function. Searches a configuration for a |
51 -- key, and returns it's value. |
47 -- key, and returns it's value. |
52 getValue :: Key -> Conf -> Maybe Value |
48 getValue :: Key -> Conf -> Maybe Value |
53 getValue k conf = case M.lookup k conf of |
49 getValue = M.lookup |
54 Just val -> Just $ stripQuotes val |
|
55 Nothing -> Nothing |
|
56 |
|
57 stripQuotes :: String -> String |
|
58 stripQuotes x | any isSpace x = filter (/= '\"') x |
|
59 | otherwise = x |
|
60 |
|
61 -- |Returns a String wrapped in quotes if it |
|
62 -- contains spaces, otherwise returns the string |
|
63 -- untouched. |
|
64 addQuotes :: String -> String |
|
65 addQuotes x | any isSpace x = "\"" ++ x ++ "\"" |
|
66 | otherwise = x |
|
67 |
50 |
68 -- |Utility function. Replaces the value |
51 -- |Utility function. Replaces the value |
69 -- associated with a key in a configuration. |
52 -- associated with a key in a configuration. |
70 repConfig :: Key -> Value -> Conf -> Conf |
53 repConfig :: Key -> Value -> Conf -> Conf |
71 repConfig k rv conf = let f _ = Just rv |
54 repConfig k rv conf = let f _ = Just rv |
72 in M.alter f k conf |
55 in M.alter f k conf |
73 |
56 |
74 -- |Reads a file and parses to a Map String String. |
57 -- |Reads a file and parses to a Map String String. |
75 readConfig :: FilePath -> IO Conf |
58 readConfig :: FilePath -> IO Conf |
76 readConfig path = readFile path >>= return . parseConfig |
59 readConfig path = liftM (M.fromList . map ((\(a, b) -> (filter (not . isSpace) a, dropWhile isSpace b)) . break (== '=')) . filter (not . null) . lines) $ readFile path |
77 |
60 |
78 -- |Parses a parsed configuration back to a file. |
61 -- |Parses a parsed configuration back to a file. |
79 writeConfig :: FilePath -> Conf -> IO () |
62 writeConfig :: FilePath -> Conf -> IO () |
80 writeConfig path con = writeFile path $ putTogether con |
63 writeConfig path = writeFile path . unlines . map (\(a, b) -> a ++ " = " ++ b) . M.toList |
81 |
|
82 -- |Turns a list of configuration types back into a String |
|
83 -- to write to a file. |
|
84 putTogether :: Conf -> String |
|
85 putTogether = concat . putTogether' . backToString |
|
86 where putTogether' (x:y:xs) = x : " = " : y : "\n" : putTogether' xs |
|
87 putTogether' _ = [] |
|
88 |
|
89 -- |Turns a list of configuration types into a list of Strings |
|
90 backToString :: Conf -> [String] |
|
91 backToString conf = backToString' $ M.toList conf |
|
92 where backToString' ((x,y):xs) = x : y : backToString' xs |
|
93 backToString' _ = [] |
|
94 |
|
95 -- |Parses a string into a list of Configuration types. |
|
96 parseConfig :: String -> Conf |
|
97 parseConfig = listConfig . popString . parse |
|
98 |
|
99 parse :: String -> [String] |
|
100 parse = words . filter (/= '=') |
|
101 |
|
102 -- |Turns a list of key value key value etc... pairs into |
|
103 -- A list of Configuration types. |
|
104 listConfig :: [String] -> Conf |
|
105 listConfig = M.fromList . helper |
|
106 where helper (x:y:xs) = (x,y) : helper xs |
|
107 helper _ = [] |
|
108 |
|
109 -- |Parses strings from the parseConfig'd file. |
|
110 popString :: [String] -> [String] |
|
111 popString [] = [] |
|
112 popString (x:xs) |
|
113 | head x == '\"' = findClose $ break (('\"' ==) . last) xs |
|
114 | otherwise = x : popString xs |
|
115 where findClose (y,ys) = |
|
116 [unwords $ x : y ++ [head ys]] ++ popString (tail ys) |
|