    {-# 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.Except (MonadError (throwError))
    import Control.Monad.State (evalState, get, put)
    import Data.Functor (($>))
    import Text.Parsec as P (
        anyChar,
        between,
        char,
        choice,
        many,
        many1,
        manyTill,
        newline,
        noneOf,
        oneOf,
     )
    import Text.Parsec.String (Parser)

    import Data.Char (isSpace)
    import Data.Ini (emptyConfig, setOption)
    import Data.Ini.Types (Config)
    import Data.List (dropWhileEnd)

    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 = String -> IniFile
    SectionL (String -> IniFile) -> Parser String -> Parser IniFile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser String -> Parser String -> Parser String -> Parser String
    forall s (m :: * -> *) t u open close a.
    Stream s m t =>
    ParsecT s u m open
    -> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
    between Parser String
    sectionNameOpen Parser String
    sectionNameClose Parser String
    forall {u}. ParsecT String u Identity String
    sectionName
      where
        sectionNameOpen :: Parser String
    sectionNameOpen = Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '[' ParsecT String () Identity Char -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser String
    eatWhiteSpace
        sectionNameClose :: Parser String
    sectionNameClose = Parser String
    eatWhiteSpace Parser String
    -> ParsecT String () Identity Char
    -> ParsecT String () Identity Char
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ']' ParsecT String () Identity Char -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
        sectionName :: ParsecT String u Identity String
    sectionName = ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 (ParsecT String u Identity Char
     -> ParsecT String u Identity String)
    -> ParsecT String u Identity Char
    -> ParsecT String u Identity String
    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
    validSecNameChrs
        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
    "._-/@\" "

    {- | 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 = String -> String -> IniFile
    OptionL (String -> String -> IniFile)
    -> Parser String -> ParsecT String () Identity (String -> IniFile)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser String
    optionName ParsecT String () Identity (String -> IniFile)
    -> Parser String -> Parser IniFile
    forall a b.
    ParsecT String () Identity (a -> b)
    -> ParsecT String () Identity a -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Parser String
    optionEqual Parser String -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser String
    forall {u}. ParsecT String u Identity String
    optionValue)
      where
        optionName :: Parser String
    optionName = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd Char -> Bool
    isSpace ShowS -> Parser String -> Parser String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser String
    eatWhiteSpace Parser String -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> 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 (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    oneOf String
    validOptNameChrs))
        optionEqual :: Parser String
    optionEqual = Parser String
    eatWhiteSpace Parser String
    -> ParsecT String () Identity Char
    -> ParsecT String () Identity Char
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '=' ParsecT String () Identity Char -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser String
    eatWhiteSpace
        optionValue :: ParsecT String u Identity String
    optionValue = 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
        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
    "_-/@ "

    {- | 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 = String -> IniFile
    OptionContL (String -> IniFile) -> Parser String -> Parser IniFile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser String
    value
      where
        value :: Parser String
    value = (:) (Char -> ShowS)
    -> ParsecT String () Identity Char
    -> ParsecT String () Identity ShowS
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    oneOf String
    " \t" ParsecT String () Identity Char -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser String
    eatWhiteSpace Parser String
    -> ParsecT String () Identity Char
    -> ParsecT String () Identity Char
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    " \t") ParsecT String () Identity ShowS -> Parser String -> Parser String
    forall a b.
    ParsecT String () Identity (a -> b)
    -> ParsecT String () Identity a -> ParsecT String () Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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

    {- | 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 = 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 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> 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
    -> String -> ParsecT String u Identity String
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> 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 -> IniFile -> Parser IniFile
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> 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]