module Data.ConfigFile.Parser
(
parse_string, parse_file, parse_handle, interpmain, ParseOutput
) where
import Text.ParserCombinators.Parsec
import Control.Monad.Error(throwError, MonadError)
import Data.String.Utils
import Data.ConfigFile.Lexer
import System.IO(Handle, hGetContents)
import Text.ParserCombinators.Parsec.Utils
import Data.ConfigFile.Types
parse_string :: MonadError CPError m =>
String -> m ParseOutput
parse_string :: forall (m :: * -> *).
MonadError CPError m =>
String -> m ParseOutput
parse_string String
s =
forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize String
"(string)" forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [GeneralizedToken CPTok]
loken String
"(string)" String
s
parse_file :: MonadError CPError m => FilePath -> IO (m ParseOutput)
parse_file :: forall (m :: * -> *).
MonadError CPError m =>
String -> IO (m ParseOutput)
parse_file String
f =
do Either ParseError [GeneralizedToken CPTok]
o <- forall a. Parser a -> String -> IO (Either ParseError a)
parseFromFile Parser [GeneralizedToken CPTok]
loken String
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize String
f Either ParseError [GeneralizedToken CPTok]
o
parse_handle :: MonadError CPError m => Handle -> IO (m ParseOutput)
parse_handle :: forall (m :: * -> *).
MonadError CPError m =>
Handle -> IO (m ParseOutput)
parse_handle Handle
h =
do String
s <- Handle -> IO String
hGetContents Handle
h
let o :: Either ParseError [GeneralizedToken CPTok]
o = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [GeneralizedToken CPTok]
loken (forall a. Show a => a -> String
show Handle
h) String
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize (forall a. Show a => a -> String
show Handle
h) Either ParseError [GeneralizedToken CPTok]
o
detokenize :: (Show t, MonadError (CPErrorData, [Char]) m) => SourceName
-> Either t [GeneralizedToken CPTok]
-> m ParseOutput
detokenize :: forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize String
fp Either t [GeneralizedToken CPTok]
l =
let conv :: b -> Either a a -> m a
conv b
msg (Left a
err) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ (String -> CPErrorData
ParseError (forall a. Show a => a -> String
show a
err), b
msg)
conv b
_ (Right a
val) = forall (m :: * -> *) a. Monad m => a -> m a
return a
val
in do [GeneralizedToken CPTok]
r <- forall {b} {m :: * -> *} {a} {a}.
(MonadError (CPErrorData, b) m, Show a) =>
b -> Either a a -> m a
conv String
"lexer" Either t [GeneralizedToken CPTok]
l
forall {b} {m :: * -> *} {a} {a}.
(MonadError (CPErrorData, b) m, Show a) =>
b -> Either a a -> m a
conv String
"parser" forall a b. (a -> b) -> a -> b
$ forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GeneralizedTokenParser CPTok () ParseOutput
main () String
fp [GeneralizedToken CPTok]
r
main :: GeneralizedTokenParser CPTok () ParseOutput
main :: GeneralizedTokenParser CPTok () ParseOutput
main =
do {ParseOutput
s <- GeneralizedTokenParser CPTok () ParseOutput
sectionlist; forall (m :: * -> *) a. Monad m => a -> m a
return ParseOutput
s}
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
[(String, String)]
o <- GeneralizedTokenParser CPTok () [(String, String)]
optionlist
ParseOutput
s <- GeneralizedTokenParser CPTok () ParseOutput
sectionlist
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String
"DEFAULT", [(String, String)]
o) forall a. a -> [a] -> [a]
: ParseOutput
s
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do {[(String, String)]
o <- GeneralizedTokenParser CPTok () [(String, String)]
optionlist; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(String
"DEFAULT", [(String, String)]
o)] }
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Error parsing config file tokens"
sectionlist :: GeneralizedTokenParser CPTok () ParseOutput
sectionlist :: GeneralizedTokenParser CPTok () ParseOutput
sectionlist = do {forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; forall (m :: * -> *) a. Monad m => a -> m a
return []}
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
String
s <- GeneralizedTokenParser CPTok () String
sectionhead
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
s, [])]
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
(String, [(String, String)])
s <- GeneralizedTokenParser CPTok () (String, [(String, String)])
section
ParseOutput
sl <- GeneralizedTokenParser CPTok () ParseOutput
sectionlist
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, [(String, String)])
s forall a. a -> [a] -> [a]
: ParseOutput
sl)
section :: GeneralizedTokenParser CPTok () (String, [(String, String)])
section :: GeneralizedTokenParser CPTok () (String, [(String, String)])
section = do {String
sh <- GeneralizedTokenParser CPTok () String
sectionhead; [(String, String)]
ol <- GeneralizedTokenParser CPTok () [(String, String)]
optionlist; forall (m :: * -> *) a. Monad m => a -> m a
return (String
sh, [(String, String)]
ol)}
sectionhead :: GeneralizedTokenParser CPTok () String
sectionhead :: GeneralizedTokenParser CPTok () String
sectionhead =
let wf :: CPTok -> Maybe String
wf (NEWSECTION String
x) = forall a. a -> Maybe a
Just String
x
wf CPTok
_ = forall a. Maybe a
Nothing
in
do {String
s <- forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe String
wf; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String
strip String
s}
optionlist :: GeneralizedTokenParser CPTok () [(String, String)]
optionlist :: GeneralizedTokenParser CPTok () [(String, String)]
optionlist = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many GeneralizedTokenParser CPTok () (String, String)
coption
coption :: GeneralizedTokenParser CPTok () (String, String)
coption :: GeneralizedTokenParser CPTok () (String, String)
coption =
let wf :: CPTok -> Maybe (String, String)
wf (NEWOPTION (String, String)
x) = forall a. a -> Maybe a
Just (String, String)
x
wf CPTok
_ = forall a. Maybe a
Nothing
wfx :: CPTok -> Maybe String
wfx (EXTENSIONLINE String
x) = forall a. a -> Maybe a
Just String
x
wfx CPTok
_ = forall a. Maybe a
Nothing
in
do (String, String)
o <- forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe (String, String)
wf
[String]
l <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe String
wfx
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
strip (forall a b. (a, b) -> a
fst (String, String)
o), [String] -> String
valmerge ((forall a b. (a, b) -> b
snd (String, String)
o) forall a. a -> [a] -> [a]
: [String]
l))
valmerge :: [String] -> String
valmerge :: [String] -> String
valmerge [String]
vallist =
let vl2 :: [String]
vl2 = forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip [String]
vallist
in forall a. [a] -> [[a]] -> [a]
join String
"\n" [String]
vl2
interpval :: Parser String
interpval :: Parser String
interpval = do
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%("
String
s <- (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
noneOf String
")") forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"interpolation name"
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
")s" forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of interpolation name"
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
percentval :: Parser String
percentval :: Parser String
percentval = do
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%%"
forall (m :: * -> *) a. Monad m => a -> m a
return String
"%"
interpother :: Parser String
interpother :: Parser String
interpother = do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"%"
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c]
interptok :: (String -> Either CPError String) -> Parser String
interptok :: (String -> Either CPError String) -> Parser String
interptok String -> Either CPError String
lookupfunc = (forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser String
percentval)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
interpother
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do String
s <- Parser String
interpval
case String -> Either CPError String
lookupfunc String
s of
Left (InterpolationError String
x, String
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
x
Left CPError
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unresolvable interpolation reference to \"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\""
Right String
x -> forall (m :: * -> *) a. Monad m => a -> m a
return String
x
interpmain :: (String -> Either CPError String) -> Parser String
interpmain :: (String -> Either CPError String) -> Parser String
interpmain String -> Either CPError String
lookupfunc =
do [String]
r <- 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 ((String -> Either CPError String) -> Parser String
interptok String -> Either CPError String
lookupfunc) forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
r