{-# 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 (IniReaderError -> IniReaderError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IniReaderError -> IniReaderError -> Bool
$c/= :: IniReaderError -> IniReaderError -> Bool
== :: IniReaderError -> IniReaderError -> Bool
$c== :: IniReaderError -> IniReaderError -> Bool
Eq, Int -> IniReaderError -> ShowS
[IniReaderError] -> ShowS
IniReaderError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IniReaderError] -> ShowS
$cshowList :: [IniReaderError] -> ShowS
show :: IniReaderError -> String
$cshow :: IniReaderError -> String
showsPrec :: Int -> IniReaderError -> ShowS
$cshowsPrec :: Int -> IniReaderError -> ShowS
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 (Int -> IniFile -> ShowS
[IniFile] -> ShowS
IniFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IniFile] -> ShowS
$cshowList :: [IniFile] -> ShowS
show :: IniFile -> String
$cshow :: IniFile -> String
showsPrec :: Int -> IniFile -> ShowS
$cshowsPrec :: Int -> IniFile -> ShowS
Show, IniFile -> IniFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IniFile -> IniFile -> Bool
$c/= :: IniFile -> IniFile -> Bool
== :: IniFile -> IniFile -> Bool
$c== :: IniFile -> IniFile -> Bool
Eq)

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

        fIfs :: [IniFile]
fIfs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. IniFile -> Bool
isComment) [IniFile]
ifs

        -- merge together OptionL and subsequent OptionContL items
        mergeOptions :: [IniFile] -> m [IniFile]
mergeOptions [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
        mergeOptions (s :: IniFile
s@(SectionL String
_) : [IniFile]
ifs') = (IniFile
s forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [IniFile] -> m [IniFile]
mergeOptions [IniFile]
ifs'
        mergeOptions (IniFile
CommentL : [IniFile]
ifs') = (IniFile
CommentL forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [IniFile] -> m [IniFile]
mergeOptions [IniFile]
ifs'
        mergeOptions (OptionL String
on String
ov : OptionContL String
ov2 : [IniFile]
ifs') = [IniFile] -> m [IniFile]
mergeOptions forall a b. (a -> b) -> a -> b
$ String -> String -> IniFile
OptionL String
on (String
ov forall a. [a] -> [a] -> [a]
++ String
ov2) forall a. a -> [a] -> [a]
: [IniFile]
ifs'
        mergeOptions (o :: IniFile
o@(OptionL String
_ String
_) : [IniFile]
ifs') = (IniFile
o forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [IniFile] -> m [IniFile]
mergeOptions [IniFile]
ifs'
        mergeOptions [IniFile]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> IniReaderError
IniSyntaxError String
"Syntax error in INI file."

        -- build the configuration from a [IniFile]
        buildit :: Config -> [IniFile] -> m Config
buildit Config
a [] = forall (m :: * -> *) a. Monad m => a -> m a
return Config
a
        buildit Config
a (SectionL String
sn : [IniFile]
is) = forall s (m :: * -> *). MonadState s m => s -> m ()
put String
sn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> [IniFile] -> m Config
buildit Config
a [IniFile]
is
        buildit Config
a (OptionL String
on String
ov : [IniFile]
is) = do
            String
sn <- forall s (m :: * -> *). MonadState s m => m s
get
            let na :: Config
na = String -> String -> String -> Config -> Config
setOption String
sn String
on String
ov Config
a
            Config -> [IniFile] -> m Config
buildit Config
na [IniFile]
is
        buildit Config
_ [IniFile]
_ = forall a. HasCallStack => a
undefined
     in
        forall {m :: * -> *}.
MonadError IniReaderError m =>
[IniFile] -> m [IniFile]
mergeOptions [IniFile]
fIfs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[IniFile]
is -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
evalState (forall {m :: * -> *}.
MonadState String m =>
Config -> [IniFile] -> m Config
buildit Config
emptyConfig [IniFile]
is) String
"default"

-- | Consumer of whitespace \"@ \t@\".
eatWhiteSpace :: Parser String
eatWhiteSpace :: Parser String
eatWhiteSpace = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \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 :: Parser IniFile
secParser =
    let
        validSecNameChrs :: String
validSecNameChrs = [Char
'a' .. Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] forall a. [a] -> [a] -> [a]
++ String
"._-/@\" "
     in
        do
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
            forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
sn <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
validSecNameChrs
            forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> IniFile
SectionL String
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 :: Parser IniFile
optLineParser =
    let
        validOptNameChrs :: String
validOptNameChrs = [Char
'a' .. Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] forall a. [a] -> [a] -> [a]
++ String
"_-/@ "
     in
        do
            forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
on <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
validOptNameChrs
            forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
            forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
ov <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> IniFile
OptionL String
on String
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 :: Parser IniFile
optContParser = do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
    forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
    Char
oc <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t"
    String
ov <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> IniFile
OptionContL forall a b. (a -> b) -> a -> b
$ Char
oc forall a. a -> [a] -> [a]
: String
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 :: Parser IniFile
noiseParser =
    let
        commentP :: ParsecT String u Identity String
commentP = do
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"#;"
            forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
        emptyL :: ParsecT String u Identity String
emptyL = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
     in
        forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall {u}. ParsecT String u Identity String
commentP, forall {u}. ParsecT String u Identity String
emptyL] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return IniFile
CommentL

iniParser :: Parser [IniFile]
iniParser :: Parser [IniFile]
iniParser =
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parser IniFile
secParser, Parser IniFile
optLineParser, Parser IniFile
optContParser, Parser IniFile
noiseParser]