4989
|
1 |
-- Module : Data.TConfig
|
|
2 |
-- Copyright : (c) Anthony Simpson 2009
|
|
3 |
-- License : BSD3
|
|
4 |
--
|
|
5 |
-- Maintainer : DiscipleRayne@gmail.com
|
|
6 |
-- Stability : relatively stable
|
|
7 |
-- Portability : portable
|
|
8 |
---------------------------------------------------
|
|
9 |
{-|
|
|
10 |
A small and simple text file configuration
|
|
11 |
library written in Haskell. It is similar
|
|
12 |
to the INI file format, but lacks a few of
|
|
13 |
it's features, such as sections. It is
|
|
14 |
suitable for simple games that need to
|
|
15 |
keep track of certain information between
|
|
16 |
plays.
|
|
17 |
-}
|
|
18 |
module Data.TConfig
|
|
19 |
(
|
|
20 |
getValue
|
|
21 |
, repConfig
|
|
22 |
, readConfig
|
|
23 |
, writeConfig
|
|
24 |
, remKey
|
|
25 |
, addKey
|
|
26 |
, Conf ()
|
|
27 |
) where
|
|
28 |
|
|
29 |
import Data.Char
|
|
30 |
import qualified Data.Map as M
|
|
31 |
|
|
32 |
type Key = String
|
|
33 |
type Value = String
|
|
34 |
type Conf = M.Map Key Value
|
|
35 |
|
|
36 |
-- |Adds a key and value to the end of the configuration.
|
|
37 |
addKey :: Key -> Value -> Conf -> Conf
|
|
38 |
addKey k v conf = M.insert k (addQuotes v) conf
|
|
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 |
|
|
45 |
-- |Utility function.
|
|
46 |
-- Removes a key and it's value from the configuration.
|
|
47 |
remKey :: Key -> Conf -> Conf
|
|
48 |
remKey k conf = M.delete k conf
|
|
49 |
|
|
50 |
-- |Utility function. Searches a configuration for a
|
|
51 |
-- key, and returns it's value.
|
|
52 |
getValue :: Key -> Conf -> Maybe Value
|
|
53 |
getValue k conf = case M.lookup k conf of
|
|
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 |
|
|
68 |
-- |Utility function. Replaces the value
|
|
69 |
-- associated with a key in a configuration.
|
|
70 |
repConfig :: Key -> Value -> Conf -> Conf
|
|
71 |
repConfig k rv conf = let f _ = Just rv
|
|
72 |
in M.alter f k conf
|
|
73 |
|
|
74 |
-- |Reads a file and parses to a Map String String.
|
|
75 |
readConfig :: FilePath -> IO Conf
|
|
76 |
readConfig path = readFile path >>= return . parseConfig
|
|
77 |
|
|
78 |
-- |Parses a parsed configuration back to a file.
|
|
79 |
writeConfig :: FilePath -> Conf -> IO ()
|
|
80 |
writeConfig path con = writeFile path $ putTogether con
|
|
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)
|