module Data.TConfig
(
Configuration
, getValue
, repConfig
, readConfig
, writeConfig
, remKey
, addKey
) where
import IO
import Data.List
import Data.Char
type Key = String
type Value = String
data Configuration = Config {
key :: Key
, value :: Value
} deriving (Show,Eq)
addKey :: Key -> Value -> [Configuration] -> [Configuration]
addKey k v conf = Config k (addQuotes v) : conf
remKey :: Key -> [Configuration] -> [Configuration]
remKey k xs = foldl' step [] xs
where step ys y | key y == k = ys
| otherwise = y : ys
getValue :: Key -> [Configuration] -> Maybe Value
getValue s (x:xs) | key x == s
= Just $ stripQuotes $ value x
| otherwise = getValue s xs
where stripQuotes a
|any isSpace a = filter (not .(== '\"')) a
getValue _ [] = Nothing
addQuotes :: String -> String
addQuotes x = if any isSpace x
then "\"" ++ x ++ "\""
else x
repConfig :: Key -> Value -> [Configuration] -> [Configuration]
repConfig k rv xs = foldl' step [] $ reverse xs
where step ds d | key d == k
= Config (key d) (addQuotes rv) : ds
| otherwise = d : ds
addQuotes a | any isSpace a = "\"" ++ a ++ "\""
readConfig :: FilePath -> IO [Configuration]
readConfig path = do
contents <- readFile path
return $ parseConfig contents
writeConfig :: FilePath -> [Configuration] -> IO ()
writeConfig path con = do
writeFile path $ putTogether con
putTogether :: [Configuration] -> String
putTogether xs = concat $ putTogether' $ backToString xs
where putTogether' (x:y:xs) = x : " = " : y : "\n" : putTogether' xs
putTogether' _ = []
backToString :: [Configuration] -> [String]
backToString ((Config x y):xs) = x : y : backToString xs
backToString _ = []
parseConfig :: String -> [Configuration]
parseConfig x = listConfig . popString . words $ filter (not . (== '=')) x
listConfig :: [String] -> [Configuration]
listConfig (x:y:xs) = Config x y : listConfig xs
listConfig _ = []
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)