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

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

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

{- | 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 = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"#;" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
        emptyL :: ParsecT String u Identity String
emptyL = (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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 (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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]