{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
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)

-- | The in-memory configuration data.
type Conf = M.Map String SettingInfo

-- | The configuration file is in an invalid format.
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