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)
import Control.Applicative ((<$>))
import Data.Maybe
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 pe -> throwIO (ParseException path
$ "Invalid configuration file " ++ show (errorPos pe))
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 $ comment <|> configEntry <|> emptyLine
let configEntries = filter isConfigEntry elements
return $ M.fromList $ map (\(ConfigEntry a b) ->
(a, SettingInfo {value=b, userSet=True})) configEntries
comment :: T.GenParser st ConfigElement
comment = char '#' >> finishLine >> return Comment
configEntry :: T.GenParser st ConfigElement
configEntry = do
key <- many1 $ noneOf " \t=\r\n"
char '='
val <- finishLine
blank <- optionMaybe $ string " "
fullVal <- if isNothing blank
then return val
else do
firstExtraLine <- finishLine
rest <- concat <$> many (string " " >> finishLine)
return $ val ++ firstExtraLine ++ rest
return $ ConfigEntry key fullVal
finishLine :: T.GenParser st String
finishLine = do
result <- many $ noneOf "\r\n"
many1 $ oneOf "\r\n"
return result
emptyLine :: T.GenParser st ConfigElement
emptyLine = do
many1 $ oneOf "\r\n"
return Comment
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 ++ "=" ++ wrap sValue
wrap :: String -> String
wrap str = if null rest
then str
else first ++ "\n " ++ wrap rest
where (first, rest) = splitAt 80 str