{-
Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org>

This program is free software; you can redistribute it and/or modify it, as
specified in the COPYRIGHT file, under the terms of either version 2.1 of
the LGPL (or, at your option, any later version) or the 3-clause BSD license.

-}

{- |
   Module     : Data.ConfigFile.Parser
   Copyright  : Copyright (C) 2004-2008 John Goerzen
   License    : Either LGPL or BSD3, as specified in the COPYRIGHT file.

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Parser support for "Data.ConfigFile".  This module is not intended to be
used directly by your programs.

Copyright (c) 2004-2008 John Goerzen, jgoerzen\@complete.org

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

-}
module Data.ConfigFile.Parser
(
 parse_string, parse_file, parse_handle, interpmain, ParseOutput
       --satisfyG,
       --main
) 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

----------------------------------------------------------------------
-- Exported funcs
----------------------------------------------------------------------

parse_string :: MonadError CPError m =>
                String -> m ParseOutput
parse_string :: forall (m :: * -> *).
MonadError CPError m =>
String -> m ParseOutput
parse_string String
s =
    String
-> Either ParseError [GeneralizedToken CPTok] -> m ParseOutput
forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize String
"(string)" (Either ParseError [GeneralizedToken CPTok] -> m ParseOutput)
-> Either ParseError [GeneralizedToken CPTok] -> m ParseOutput
forall a b. (a -> b) -> a -> b
$ Parsec String () [GeneralizedToken CPTok]
-> String -> String -> Either ParseError [GeneralizedToken CPTok]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [GeneralizedToken CPTok]
loken String
"(string)" String
s

--parse_file :: FilePath -> IO (CPResult ParseOutput)
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 <- Parsec String () [GeneralizedToken CPTok]
-> String -> IO (Either ParseError [GeneralizedToken CPTok])
forall a. Parser a -> String -> IO (Either ParseError a)
parseFromFile Parsec String () [GeneralizedToken CPTok]
loken String
f
       m ParseOutput -> IO (m ParseOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (m ParseOutput -> IO (m ParseOutput))
-> m ParseOutput -> IO (m ParseOutput)
forall a b. (a -> b) -> a -> b
$ String
-> Either ParseError [GeneralizedToken CPTok] -> m ParseOutput
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 :: Handle -> IO (CPResult ParseOutput)
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 = Parsec String () [GeneralizedToken CPTok]
-> String -> String -> Either ParseError [GeneralizedToken CPTok]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [GeneralizedToken CPTok]
loken (Handle -> String
forall a. Show a => a -> String
show Handle
h) String
s
       m ParseOutput -> IO (m ParseOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (m ParseOutput -> IO (m ParseOutput))
-> m ParseOutput -> IO (m ParseOutput)
forall a b. (a -> b) -> a -> b
$ String
-> Either ParseError [GeneralizedToken CPTok] -> m ParseOutput
forall t (m :: * -> *).
(Show t, MonadError CPError m) =>
String -> Either t [GeneralizedToken CPTok] -> m ParseOutput
detokenize (Handle -> String
forall a. Show a => a -> String
show Handle
h) Either ParseError [GeneralizedToken CPTok]
o

----------------------------------------------------------------------
-- Private funcs
----------------------------------------------------------------------
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) = (CPErrorData, b) -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ((CPErrorData, b) -> m a) -> (CPErrorData, b) -> m a
forall a b. (a -> b) -> a -> b
$ (String -> CPErrorData
ParseError (a -> String
forall a. Show a => a -> String
show a
err), b
msg)
        conv b
_ (Right a
val) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
        in do [GeneralizedToken CPTok]
r <- String
-> Either t [GeneralizedToken CPTok] -> m [GeneralizedToken CPTok]
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
              String -> Either ParseError ParseOutput -> m ParseOutput
forall {b} {m :: * -> *} {a} {a}.
(MonadError (CPErrorData, b) m, Show a) =>
b -> Either a a -> m a
conv String
"parser" (Either ParseError ParseOutput -> m ParseOutput)
-> Either ParseError ParseOutput -> m ParseOutput
forall a b. (a -> b) -> a -> b
$ GenParser (GeneralizedToken CPTok) () ParseOutput
-> ()
-> String
-> [GeneralizedToken CPTok]
-> Either ParseError ParseOutput
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser (GeneralizedToken CPTok) () ParseOutput
main () String
fp [GeneralizedToken CPTok]
r

main :: GeneralizedTokenParser CPTok () ParseOutput
main :: GenParser (GeneralizedToken CPTok) () ParseOutput
main =
    do {ParseOutput
s <- GenParser (GeneralizedToken CPTok) () ParseOutput
sectionlist; ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ParseOutput
s}
    GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
             [(String, String)]
o <- GeneralizedTokenParser CPTok () [(String, String)]
optionlist
             ParseOutput
s <- GenParser (GeneralizedToken CPTok) () ParseOutput
sectionlist
             ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput)
-> ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall a b. (a -> b) -> a -> b
$ (String
"DEFAULT", [(String, String)]
o) (String, [(String, String)]) -> ParseOutput -> ParseOutput
forall a. a -> [a] -> [a]
: ParseOutput
s
            )
    GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
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; ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput)
-> ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall a b. (a -> b) -> a -> b
$ [(String
"DEFAULT", [(String, String)]
o)] }
    GenParser (GeneralizedToken CPTok) () ParseOutput
-> String -> GenParser (GeneralizedToken CPTok) () ParseOutput
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 :: GenParser (GeneralizedToken CPTok) () ParseOutput
sectionlist = do {ParsecT [GeneralizedToken CPTok] () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof; ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return []}
              GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
                       String
s <- GeneralizedTokenParser CPTok () String
sectionhead
                       ParsecT [GeneralizedToken CPTok] () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                       ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
s, [])]
                      )
              GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
-> GenParser (GeneralizedToken CPTok) () ParseOutput
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 <- GenParser (GeneralizedToken CPTok) () ParseOutput
sectionlist
                  ParseOutput -> GenParser (GeneralizedToken CPTok) () ParseOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, [(String, String)])
s (String, [(String, String)]) -> ParseOutput -> ParseOutput
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; (String, [(String, String)])
-> GeneralizedTokenParser CPTok () (String, [(String, String)])
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) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
        wf CPTok
_ = Maybe String
forall a. Maybe a
Nothing
        in
        do {String
s <- (CPTok -> Maybe String) -> GeneralizedTokenParser CPTok () String
forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe String
wf; String -> GeneralizedTokenParser CPTok () String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> GeneralizedTokenParser CPTok () String)
-> String -> GeneralizedTokenParser CPTok () String
forall a b. (a -> b) -> a -> b
$ String -> String
strip String
s}

optionlist :: GeneralizedTokenParser CPTok () [(String, String)]
optionlist :: GeneralizedTokenParser CPTok () [(String, String)]
optionlist = ParsecT [GeneralizedToken CPTok] () Identity (String, String)
-> GeneralizedTokenParser CPTok () [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [GeneralizedToken CPTok] () Identity (String, String)
coption

coption :: GeneralizedTokenParser CPTok () (String, String)
coption :: ParsecT [GeneralizedToken CPTok] () Identity (String, String)
coption =
    let wf :: CPTok -> Maybe (String, String)
wf (NEWOPTION (String, String)
x) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
x
        wf CPTok
_ = Maybe (String, String)
forall a. Maybe a
Nothing
        wfx :: CPTok -> Maybe String
wfx (EXTENSIONLINE String
x) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
        wfx CPTok
_ = Maybe String
forall a. Maybe a
Nothing
        in
        do (String, String)
o <- (CPTok -> Maybe (String, String))
-> ParsecT [GeneralizedToken CPTok] () Identity (String, String)
forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe (String, String)
wf
           [String]
l <- GeneralizedTokenParser CPTok () String
-> ParsecT [GeneralizedToken CPTok] () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (GeneralizedTokenParser CPTok () String
 -> ParsecT [GeneralizedToken CPTok] () Identity [String])
-> GeneralizedTokenParser CPTok () String
-> ParsecT [GeneralizedToken CPTok] () Identity [String]
forall a b. (a -> b) -> a -> b
$ (CPTok -> Maybe String) -> GeneralizedTokenParser CPTok () String
forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng CPTok -> Maybe String
wfx
           (String, String)
-> ParsecT [GeneralizedToken CPTok] () Identity (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
strip ((String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
o), [String] -> String
valmerge (((String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
o) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
l))

valmerge :: [String] -> String
valmerge :: [String] -> String
valmerge [String]
vallist =
    let vl2 :: [String]
vl2 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip [String]
vallist
        in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
join String
"\n" [String]
vl2

----------------------------------------------------------------------
-- Interpolation
----------------------------------------------------------------------

interpval :: Parser String
interpval :: Parser String
interpval  = do
            String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%("
            String
s <- (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
noneOf String
")") Parser String -> String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"interpolation name"
            String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
")s"               Parser String -> String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of interpolation name"
            String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

percentval :: Parser String
percentval :: Parser String
percentval = do
             String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%%"
             String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"%"

interpother :: Parser String
interpother :: Parser String
interpother = do
              Char
c <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"%"
              String -> Parser 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 = (Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser String
percentval)
                       Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
interpother
                       Parser String -> Parser String -> Parser String
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
_) -> String -> Parser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
x
                                 Left CPError
_ -> String -> Parser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"unresolvable interpolation reference to \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
                                 Right String
x -> String -> Parser String
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 <- Parser String
-> ParsecT String () Identity ()
-> ParsecT String () 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 ((String -> Either CPError String) -> Parser String
interptok String -> Either CPError String
lookupfunc) ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
       String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
r