Internals.hs

{-# LANGUAGE FlexibleContexts #-}

{- |
Module    : Data.Ini.Reader.Internals
Copyright : 2011-2014 Magnus Therning
License   : BSD3

Internal functions used in 'Data.Ini.Reader'.
-}
module Data.Ini.Reader.Internals where

import Control.Monad (void)
import Control.Monad.Except (MonadError (throwError))
import Control.Monad.State (evalState, get, put)
import Text.Parsec as P (
    anyChar,
    char,
    choice,
    many,
    many1,
    manyTill,
    newline,
    noneOf,
    oneOf,
 )
import Text.Parsec.String (Parser)

import Data.Ini
import Data.Ini.Types

data IniReaderError
    = IniParserError String
    | IniSyntaxError String
    | IniOtherError String
    deriving (Eq, Show)

type IniParseResult = Either IniReaderError

-- | The type used to represent a line of a config file.
data IniFile
    = SectionL String
    | OptionL String String
    | OptionContL String
    | CommentL
    deriving (Show, Eq)

-- | Build a configuration from a list of 'IniFile' items.
buildConfig :: [IniFile] -> IniParseResult Config
buildConfig ifs =
    let
        isComment CommentL = True
        isComment _ = False

        fIfs = filter (not . isComment) ifs

        -- merge together OptionL and subsequent OptionContL items
        mergeOptions [] = return []
        mergeOptions (s@(SectionL _) : ifs') = (s :) `fmap` mergeOptions ifs'
        mergeOptions (CommentL : ifs') = (CommentL :) `fmap` mergeOptions ifs'
        mergeOptions (OptionL on ov : OptionContL ov2 : ifs') = mergeOptions $ OptionL on (ov ++ ov2) : ifs'
        mergeOptions (o@(OptionL _ _) : ifs') = (o :) `fmap` mergeOptions ifs'
        mergeOptions _ = throwError $ IniSyntaxError "Syntax error in INI file."

        -- build the configuration from a [IniFile]
        buildit a [] = return a
        buildit a (SectionL sn : is) = put sn >> buildit a is
        buildit a (OptionL on ov : is) = do
            sn <- get
            let na = setOption sn on ov a
            buildit na is
        buildit _ _ = undefined
     in
        mergeOptions fIfs >>= \is -> return $ evalState (buildit emptyConfig is) "default"

-- | Consumer of whitespace \"@ \t@\".
eatWhiteSpace :: Parser String
eatWhiteSpace = many $ oneOf " \t"

{- | Parser for the start-of-section line.  It expects the line to start with a
@[@ then find the section name, and finally a @]@.  The section name may be
surrounded by any number of white space characters (see 'eatWhiteSpace').
-}
secParser :: Parser IniFile
secParser =
    let
        validSecNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "._-/@\" "
     in
        do
            void $ char '['
            void eatWhiteSpace
            sn <- many1 $ oneOf validSecNameChrs
            void eatWhiteSpace
            void $ char ']'
            void $ manyTill anyChar newline
            return $ SectionL sn

{- | Parser for a single line of an option.  The line must start with an option
name, then a @=@ must be found, and finally the rest of the line is taken as
the option value.  The equal sign may be surrounded by any number of white
space characters (see 'eatWhiteSpace').
-}
optLineParser :: Parser IniFile
optLineParser =
    let
        validOptNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "_-/@ "
     in
        do
            void eatWhiteSpace
            on <- many1 $ oneOf validOptNameChrs
            void eatWhiteSpace
            void $ char '='
            void eatWhiteSpace
            ov <- manyTill anyChar newline
            return $ OptionL on ov

{- | Parser for an option-value continuation line.  The line must start with
either a space or a tab character (\"@ \t@\").  Everything else on the line,
until the newline character, is taken as the continuation of an option
value.
-}
optContParser :: Parser IniFile
optContParser = do
    void $ oneOf " \t"
    void eatWhiteSpace
    oc <- noneOf " \t"
    ov <- manyTill anyChar newline
    return $ OptionContL $ oc : ov

{- | Parser for "noise" in the configuration file, such as comments and empty
lines.  (Note that lines containing only space characters will be
successfully parsed by 'optContParser'.)
-}
noiseParser :: Parser IniFile
noiseParser =
    let
        commentP = do
            void $ oneOf "#;"
            manyTill anyChar newline
        emptyL = newline >> return ""
     in
        choice [commentP, emptyL] >> return CommentL

iniParser :: Parser [IniFile]
iniParser =
    many $ choice [secParser, optLineParser, optContParser, noiseParser]