{-# LANGUAGE FlexibleContexts #-}
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
data IniFile
= SectionL String
| OptionL String String
| OptionContL String
|
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)
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
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."
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"
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"
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
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
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
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]