{-# 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
(IniReaderError -> IniReaderError -> Bool)
-> (IniReaderError -> IniReaderError -> Bool) -> Eq IniReaderError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IniReaderError -> IniReaderError -> Bool
== :: IniReaderError -> IniReaderError -> Bool
$c/= :: IniReaderError -> IniReaderError -> Bool
/= :: IniReaderError -> IniReaderError -> Bool
Eq, Int -> IniReaderError -> ShowS
[IniReaderError] -> ShowS
IniReaderError -> String
(Int -> IniReaderError -> ShowS)
-> (IniReaderError -> String)
-> ([IniReaderError] -> ShowS)
-> Show IniReaderError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IniReaderError -> ShowS
showsPrec :: Int -> IniReaderError -> ShowS
$cshow :: IniReaderError -> String
show :: IniReaderError -> String
$cshowList :: [IniReaderError] -> ShowS
showList :: [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
(Int -> IniFile -> ShowS)
-> (IniFile -> String) -> ([IniFile] -> ShowS) -> Show IniFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IniFile -> ShowS
showsPrec :: Int -> IniFile -> ShowS
$cshow :: IniFile -> String
show :: IniFile -> String
$cshowList :: [IniFile] -> ShowS
showList :: [IniFile] -> ShowS
Show, IniFile -> IniFile -> Bool
(IniFile -> IniFile -> Bool)
-> (IniFile -> IniFile -> Bool) -> Eq IniFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IniFile -> IniFile -> Bool
== :: IniFile -> IniFile -> Bool
$c/= :: IniFile -> IniFile -> Bool
/= :: 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 = (IniFile -> Bool) -> [IniFile] -> [IniFile]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (IniFile -> Bool) -> IniFile -> Bool
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 [] = [IniFile] -> m [IniFile]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        mergeOptions (s :: IniFile
s@(SectionL String
_) : [IniFile]
ifs') = (IniFile
s IniFile -> [IniFile] -> [IniFile]
forall a. a -> [a] -> [a]
:) ([IniFile] -> [IniFile]) -> m [IniFile] -> m [IniFile]
forall a b. (a -> b) -> m a -> m b
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 IniFile -> [IniFile] -> [IniFile]
forall a. a -> [a] -> [a]
:) ([IniFile] -> [IniFile]) -> m [IniFile] -> m [IniFile]
forall a b. (a -> b) -> m a -> m b
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 ([IniFile] -> m [IniFile]) -> [IniFile] -> m [IniFile]
forall a b. (a -> b) -> a -> b
$ String -> String -> IniFile
OptionL String
on (String
ov String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ov2) IniFile -> [IniFile] -> [IniFile]
forall a. a -> [a] -> [a]
: [IniFile]
ifs'
        mergeOptions (o :: IniFile
o@(OptionL String
_ String
_) : [IniFile]
ifs') = (IniFile
o IniFile -> [IniFile] -> [IniFile]
forall a. a -> [a] -> [a]
:) ([IniFile] -> [IniFile]) -> m [IniFile] -> m [IniFile]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [IniFile] -> m [IniFile]
mergeOptions [IniFile]
ifs'
        mergeOptions [IniFile]
_ = IniReaderError -> m [IniFile]
forall a. IniReaderError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (IniReaderError -> m [IniFile]) -> IniReaderError -> m [IniFile]
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 [] = Config -> m Config
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
a
        buildit Config
a (SectionL String
sn : [IniFile]
is) = String -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put String
sn m () -> m Config -> m Config
forall a b. m a -> m b -> m b
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 <- m String
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]
_ = m Config
forall a. HasCallStack => a
undefined
     in
        [IniFile] -> Either IniReaderError [IniFile]
forall {m :: * -> *}.
MonadError IniReaderError m =>
[IniFile] -> m [IniFile]
mergeOptions [IniFile]
fIfs Either IniReaderError [IniFile]
-> ([IniFile] -> IniParseResult Config) -> IniParseResult Config
forall a b.
Either IniReaderError a
-> (a -> Either IniReaderError b) -> Either IniReaderError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[IniFile]
is -> Config -> IniParseResult Config
forall a. a -> Either IniReaderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IniParseResult Config)
-> Config -> IniParseResult Config
forall a b. (a -> b) -> a -> b
$ State String Config -> String -> Config
forall s a. State s a -> s -> a
evalState (Config -> [IniFile] -> State String Config
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 = ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
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'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"._-/@\" "
     in
        do
            ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
sn <- ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
validSecNameChrs
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser String -> ParsecT String () Identity ())
-> Parser String -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser 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 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
            IniFile -> Parser IniFile
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IniFile -> Parser IniFile) -> IniFile -> Parser IniFile
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'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_-/@ "
     in
        do
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
on <- ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
validOptNameChrs
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
            Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
            String
ov <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser 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 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
            IniFile -> Parser IniFile
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IniFile -> Parser IniFile) -> IniFile -> Parser IniFile
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
    ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
    Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
eatWhiteSpace
    Char
oc <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
" \t"
    String
ov <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser 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 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    IniFile -> Parser IniFile
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IniFile -> Parser IniFile) -> IniFile -> Parser IniFile
forall a b. (a -> b) -> a -> b
$ String -> IniFile
OptionContL (String -> IniFile) -> String -> IniFile
forall a b. (a -> b) -> a -> b
$ Char
oc Char -> ShowS
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
            ParsecT String u Identity Char -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"#;"
            ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity 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 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
        emptyL :: ParsecT String u Identity String
emptyL = ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
     in
        [Parser String] -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parser String
forall {u}. ParsecT String u Identity String
commentP, Parser String
forall {u}. ParsecT String u Identity String
emptyL] Parser String -> Parser IniFile -> Parser IniFile
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IniFile -> Parser IniFile
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return IniFile
CommentL

iniParser :: Parser [IniFile]
iniParser :: Parser [IniFile]
iniParser =
    Parser IniFile -> Parser [IniFile]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser IniFile -> Parser [IniFile])
-> Parser IniFile -> Parser [IniFile]
forall a b. (a -> b) -> a -> b
$ [Parser IniFile] -> Parser IniFile
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]