{-# 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
import Control.Monad.State
import qualified Data.ByteString as BS
import Text.Parsec as P
import Text.Parsec.String

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
/= :: IniReaderError -> IniReaderError -> Bool
$c/= :: IniReaderError -> IniReaderError -> Bool
== :: IniReaderError -> IniReaderError -> Bool
$c== :: 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
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
(Int -> IniFile -> ShowS)
-> (IniFile -> String) -> ([IniFile] -> ShowS) -> Show IniFile
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
(IniFile -> IniFile -> Bool)
-> (IniFile -> IniFile -> Bool) -> Eq IniFile
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 = (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 (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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` [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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` [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
on String
ov) : [IniFile]
ifs) = (IniFile
o IniFile -> [IniFile] -> [IniFile]
forall a. a -> [a] -> [a]
:) ([IniFile] -> [IniFile]) -> m [IniFile] -> m [IniFile]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` [IniFile] -> m [IniFile]
mergeOptions [IniFile]
ifs
        mergeOptions [IniFile]
_ = IniReaderError -> m [IniFile]
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 (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 (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

    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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ [IniFile]
is -> Config -> IniParseResult Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IniParseResult Config)
-> ((Config, String) -> Config)
-> (Config, String)
-> IniParseResult Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config, String) -> Config
forall a b. (a, b) -> a
fst ((Config, String) -> IniParseResult Config)
-> (Config, String) -> IniParseResult Config
forall a b. (a -> b) -> a -> b
$ State String Config -> String -> (Config, String)
forall s a. State s a -> s -> (a, s)
runState (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
        Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
        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
eatWhiteSpace
        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
-> 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 (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
        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
eatWhiteSpace
        Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
        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 (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
    String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
    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 (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
ocChar -> 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
            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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IniFile -> Parser IniFile
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]