{-# 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)
import Control.Applicative ((<$>))
import Data.Maybe

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 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
	-- so now we finished the parsing of the classical
	-- key=value, however we support a little bit more,
	-- you can do something like that:
	-- key=[1,2,
	--  3,4,
	--  5, 6]
	-- In that case the value will be
	--  "[1,2,3,4,5, 6]"
	--  => we can continue a setting on the next
	--  line if that lines starts with a leading space.
	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