{-
Copyright 2013, 2014 Marcelo Garlet Millani
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
{-|
Module      : DescriLo
Description : 
Copyright   : (c) Marcelo Garlet Millani
License     : GPL-3
Maintainer  : marcelogmillani@gmail.com
Stability   : experimental

Loads a file or 'String' into a list of 'Description's. 'Description's with the same name are allowed.

Example file:

>[item A] # the first item
>  property 1 = value 1 # indentation is ignored
>  property 2 = value 2
>[item B]
>  something=else # whitespaces after and before each value / property are ignored


-}
module Data.DescriLo(loadDescriptionFile, loadDescriptionString, checkAttribute, Description(Description, name, values)) where

import System.IO

data Description =
	Description {
		name :: String,
		values :: [(String,String)]
	}

instance Show Description where
	show Description {name=n, values=vs} =
		"[" ++ n ++ "]\n" ++ foldl (++) "" (map (\(x,y) -> "\t" ++ x ++ " = " ++ y ++ "\n") vs)

data Element a = Variable a a | Definition a | Nil deriving Show

trimL (' ':r) = trimL r
trimL ('\t':r) = trimL r
trimL str = str

trimR [] = []
trimR (' ':[]) = []
trimR ('\t':[]) = []
trimR (h:r) =
	let trimmed = trimR r in
	case trimmed of
		[] -> [h]
		' ':[] -> [h]
		'\t':[] -> [h]
		a -> h:a

trim s = trimR $ trimL s

-- | loads all descriptions from a file
--
-- usage: loadDescriptionFile filename defaultName
--
-- loads the given file, using 'defaultName' as the default description name in case the document doesn't start with the definition of one

loadDescriptionFile fname defName = do
	fl <- readFile fname
	return $ loadDescriptionString fl defName

-- | loads all descriptions from a string
--
-- usage: loadDescriptionString string defaultName
--
-- behaves just like loadDescriptionFile, but receives a 'String' instead
loadDescriptionString string defaultName =
	let lns = lines string in
	loadDescriptions lns Description{name = defaultName, values = []}

-- returns a list of descriptions
loadDescriptions lns cat = loadDescriptions' lns cat False
loadDescriptions' [] cat hasVars = if hasVars then [cat] else []
loadDescriptions' (h:rest) cat hasVars =
	let ln = loadLine h in
	case ln of
		Variable left right ->
			let loaded = loadDescriptions' rest cat True in
			case loaded of
				[] -> [cat{values = [(left,right)]}]
				(rcat:rrest) -> rcat{values = (left,right):values rcat}:rrest
		Definition newName -> (if hasVars then (cat :) else id) $ loadDescriptions' rest Description{name = newName, values = []} False
		Nil -> loadDescriptions' rest cat hasVars

-- returns an Element
loadLine ln =
	case ln of
		' ':rest -> loadLine rest
		'\t':rest -> loadLine rest
		'#':_ -> Nil
		'\n':_ -> Nil
		'[':rest -> Definition $ loadDescription rest
		_ -> loadVariable ln

loadDescription ln =
	case ln of
		[] -> ""
		']':[] -> ""
		h:rest -> h:loadDescription rest

-- if ln is l = r, returns Variable l r
-- trims l and r, so that there are no whitespaces before or after
loadVariable ln =
	let (left,right) = loadVariableLeft ln in
	case (trim left, trim right) of
		([],_) -> Nil
		(_,[]) -> Nil
		(a,b) -> Variable a b

loadVariableLeft [] = ([],[])
loadVariableLeft (h:rest) =
	let (left,right) = loadVariableLeft rest in
	case h of
		'=' -> ([], rest)
		_ -> (h:left,loadVariableRight right)

-- removes comments to the right of the value
loadVariableRight [] = []
loadVariableRight ('#':r) = []
loadVariableRight (h:r) = h:loadVariableRight r

-- | checks if the specified attribute satisfies the given function, when it exists
-- if the given attribute does not exist, returns False
checkAttribute lval compareF Description{values = (h:r)} = checkAttribute' lval compareF (h:r)
checkAttribute' _ _ [] = False
checkAttribute' lval compareF ((l,r):rest) =
	if l == lval then compareF r else checkAttribute' lval compareF rest