module Data.Serialization (
Conf,
SettingInfo(..),
readConfigFile,
writeConfigFile,
ParseException) where
import System.IO
import qualified Data.Text.IO as T
import qualified Data.Map as M
import Text.ParserCombinators.Parsec
import Text.Parsec.Text as T
import Control.Monad (unless, when)
import Control.Exception (throwIO, Exception)
import Data.Typeable (Typeable)
import System.Directory (doesFileExist, copyFile)
data SettingInfo = SettingInfo { value :: String, userSet :: Bool } deriving (Show, Eq)
type Conf = M.Map String SettingInfo
data ParseException = ParseException FilePath String
deriving (Show, Typeable)
instance Exception ParseException
readConfigFile :: FilePath -> IO Conf
readConfigFile path = do
contents <- T.readFile path
case parse parseConfigFile "" contents of
Left _ -> throwIO $ ParseException path "Invalid configuration file"
Right v -> return v
data ConfigElement = ConfigEntry String String
| Comment
isConfigEntry :: ConfigElement -> Bool
isConfigEntry (ConfigEntry _ _) = True
isConfigEntry _ = False
parseConfigFile :: T.GenParser st Conf
parseConfigFile = do
elements <- many $ parseComment <|> parseConfigEntry
let configEntries = filter isConfigEntry elements
return $ M.fromList $ map (\(ConfigEntry a b) ->
(a, SettingInfo {value=b, userSet=True})) configEntries
parseComment :: T.GenParser st ConfigElement
parseComment = do
char '#'
many $ noneOf "\r\n"
many $ oneOf "\r\n"
return Comment
parseConfigEntry :: T.GenParser st ConfigElement
parseConfigEntry = do
key <- many $ noneOf "=\r\n"
char '='
val <- many $ noneOf "\r\n"
many $ oneOf "\r\n"
return $ ConfigEntry key val
writeConfigFile :: FilePath -> Conf -> IO ()
writeConfigFile path config = do
whenM (doesFileExist path) $
copyFile path $ path ++ ".bak"
withFile path WriteMode $ \handle -> do
hPutStrLn handle "# This file is autogenerated. You can change, comment and uncomment settings but text comments you may add will be lost."
mapM_ (uncurry $ writeConfigEntry handle) $ M.toList config
where whenM s r = s >>= flip when r
writeConfigEntry :: Handle -> String -> SettingInfo -> IO ()
writeConfigEntry handle key (SettingInfo sValue sUserSet) = do
unless sUserSet $ hPutStr handle "# "
hPutStrLn handle $ key ++ "=" ++ sValue