descrilo-0.1.0.3: Data/DescriLo.hs

{-
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