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)