{- arch-tag: ConfigParser lexer support
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.Lexer
   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

Lexer 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.Lexer
(
       -- -- * Temporary for testing
       --comment_chars, eol, optionsep, whitespace_chars, comment_line,
       --empty_line, sectheader_chars, sectheader, oname_chars, value_chars,
       --extension_line, optionkey, optionvalue, optionpair
       loken,
       CPTok(..)
) where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Utils

data CPTok = IGNOREDATA
           | NEWSECTION String
           | NEWSECTION_EOF String
           | EXTENSIONLINE String
           | NEWOPTION (String, String)
             deriving (CPTok -> CPTok -> Bool
(CPTok -> CPTok -> Bool) -> (CPTok -> CPTok -> Bool) -> Eq CPTok
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPTok -> CPTok -> Bool
$c/= :: CPTok -> CPTok -> Bool
== :: CPTok -> CPTok -> Bool
$c== :: CPTok -> CPTok -> Bool
Eq, Int -> CPTok -> ShowS
[CPTok] -> ShowS
CPTok -> String
(Int -> CPTok -> ShowS)
-> (CPTok -> String) -> ([CPTok] -> ShowS) -> Show CPTok
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPTok] -> ShowS
$cshowList :: [CPTok] -> ShowS
show :: CPTok -> String
$cshow :: CPTok -> String
showsPrec :: Int -> CPTok -> ShowS
$cshowsPrec :: Int -> CPTok -> ShowS
Show, Eq CPTok
Eq CPTok =>
(CPTok -> CPTok -> Ordering)
-> (CPTok -> CPTok -> Bool)
-> (CPTok -> CPTok -> Bool)
-> (CPTok -> CPTok -> Bool)
-> (CPTok -> CPTok -> Bool)
-> (CPTok -> CPTok -> CPTok)
-> (CPTok -> CPTok -> CPTok)
-> Ord CPTok
CPTok -> CPTok -> Bool
CPTok -> CPTok -> Ordering
CPTok -> CPTok -> CPTok
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CPTok -> CPTok -> CPTok
$cmin :: CPTok -> CPTok -> CPTok
max :: CPTok -> CPTok -> CPTok
$cmax :: CPTok -> CPTok -> CPTok
>= :: CPTok -> CPTok -> Bool
$c>= :: CPTok -> CPTok -> Bool
> :: CPTok -> CPTok -> Bool
$c> :: CPTok -> CPTok -> Bool
<= :: CPTok -> CPTok -> Bool
$c<= :: CPTok -> CPTok -> Bool
< :: CPTok -> CPTok -> Bool
$c< :: CPTok -> CPTok -> Bool
compare :: CPTok -> CPTok -> Ordering
$ccompare :: CPTok -> CPTok -> Ordering
$cp1Ord :: Eq CPTok
Ord)

comment_chars :: CharParser st Char
comment_chars :: CharParser st Char
comment_chars = String -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "#;"
eol :: GenParser Char st String
eol :: GenParser Char st String
eol = String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "\n" GenParser Char st String
-> GenParser Char st String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "\r\n" GenParser Char st String
-> GenParser Char st String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "\r" GenParser Char st String -> String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "End of line"
eoleof :: GenParser Char st ()
eoleof :: GenParser Char st ()
eoleof = GenParser Char st ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof GenParser Char st ()
-> GenParser Char st () -> GenParser Char st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do {GenParser Char st String
forall st. GenParser Char st String
eol; () -> GenParser Char st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()}
optionsep :: GenParser Char st Char
optionsep :: GenParser Char st Char
optionsep = String -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ":=" GenParser Char st Char -> String -> GenParser Char st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "option separator"
whitespace_chars :: GenParser Char st Char
whitespace_chars :: GenParser Char st Char
whitespace_chars = String -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf " \t" GenParser Char st Char -> String -> GenParser Char st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "whitespace"
comment_line :: GenParser Char st ()
comment_line :: GenParser Char st ()
comment_line = do ParsecT String st Identity Char -> GenParser Char st ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String st Identity Char
forall st. GenParser Char st Char
whitespace_chars
                  ParsecT String st Identity Char
forall st. GenParser Char st Char
comment_chars             ParsecT String st Identity Char
-> String -> ParsecT String st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "start of comment"
                  (ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char
 -> ParsecT String st Identity String)
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\r\n")   ParsecT String st Identity String
-> String -> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "content of comment"
                  GenParser Char st ()
forall st. GenParser Char st ()
eoleof
eolstuff :: GenParser Char st ()
eolstuff :: GenParser Char st ()
eolstuff = (GenParser Char st () -> GenParser Char st ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char st ()
forall st. GenParser Char st ()
comment_line) GenParser Char st ()
-> GenParser Char st () -> GenParser Char st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (GenParser Char st () -> GenParser Char st ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char st ()
forall st. GenParser Char st ()
empty_line)
empty_line :: GenParser Char st ()
empty_line :: GenParser Char st ()
empty_line = do ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall st. GenParser Char st Char
whitespace_chars
                GenParser Char st ()
forall st. GenParser Char st ()
eoleof
             GenParser Char st () -> String -> GenParser Char st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "empty line"
sectheader_chars :: CharParser st Char
sectheader_chars :: CharParser st Char
sectheader_chars = String -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "]\r\n"
sectheader :: GenParser Char st String
sectheader :: GenParser Char st String
sectheader = do Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '['
                String
sname <- ParsecT String st Identity Char -> GenParser Char st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String st Identity Char -> GenParser Char st String)
-> ParsecT String st Identity Char -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity Char
forall st. GenParser Char st Char
sectheader_chars
                Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ']'
                GenParser Char st ()
forall st. GenParser Char st ()
eolstuff
                String -> GenParser Char st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
sname
             GenParser Char st String -> String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "start of section"
oname_chars :: CharParser st Char
oname_chars :: CharParser st Char
oname_chars = String -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf ":=\r\n"
value_chars :: CharParser st Char
value_chars :: CharParser st Char
value_chars = String -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\r\n"
extension_line :: GenParser Char st String
extension_line :: GenParser Char st String
extension_line = do ParsecT String st Identity Char -> GenParser Char st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity Char
forall st. GenParser Char st Char
whitespace_chars
                    Char
c1 <- String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\r\n#;"
                    String
remainder <- ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall st. GenParser Char st Char
value_chars
                    GenParser Char st ()
forall st. GenParser Char st ()
eolstuff
                    String -> GenParser Char st String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c1 Char -> ShowS
forall a. a -> [a] -> [a]
: String
remainder)

optionkey, optionvalue :: GenParser Char st String
optionkey :: GenParser Char st String
optionkey = ParsecT String st Identity Char -> GenParser Char st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity Char
forall st. GenParser Char st Char
oname_chars
optionvalue :: GenParser Char st String
optionvalue = ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall st. GenParser Char st Char
value_chars
optionpair :: GenParser Char st (String, String)
optionpair :: GenParser Char st (String, String)
optionpair = do String
key <- GenParser Char st String
forall st. GenParser Char st String
optionkey
                String
value <- String -> GenParser Char st String -> GenParser Char st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ do { GenParser Char st Char
forall st. GenParser Char st Char
optionsep; GenParser Char st String
forall st. GenParser Char st String
optionvalue }
                GenParser Char st ()
forall st. GenParser Char st ()
eolstuff
                (String, String) -> GenParser Char st (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
value)
             GenParser Char st (String, String)
-> String -> GenParser Char st (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "key/value option"

iloken :: Parser (GeneralizedToken CPTok)
iloken :: Parser (GeneralizedToken CPTok)
iloken =
    -- Ignore these things
    Parser (GeneralizedToken CPTok) -> Parser (GeneralizedToken CPTok)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do {GenParser Char () ()
forall st. GenParser Char st ()
comment_line; CPTok -> Parser (GeneralizedToken CPTok)
forall a b st. a -> GenParser b st (GeneralizedToken a)
togtok (CPTok -> Parser (GeneralizedToken CPTok))
-> CPTok -> Parser (GeneralizedToken CPTok)
forall a b. (a -> b) -> a -> b
$ CPTok
IGNOREDATA})
    Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (GeneralizedToken CPTok) -> Parser (GeneralizedToken CPTok)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do {GenParser Char () ()
forall st. GenParser Char st ()
empty_line; CPTok -> Parser (GeneralizedToken CPTok)
forall a b st. a -> GenParser b st (GeneralizedToken a)
togtok (CPTok -> Parser (GeneralizedToken CPTok))
-> CPTok -> Parser (GeneralizedToken CPTok)
forall a b. (a -> b) -> a -> b
$ CPTok
IGNOREDATA})

    -- Real stuff
    Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do {String
sname <- GenParser Char () String
forall st. GenParser Char st String
sectheader; CPTok -> Parser (GeneralizedToken CPTok)
forall a b st. a -> GenParser b st (GeneralizedToken a)
togtok (CPTok -> Parser (GeneralizedToken CPTok))
-> CPTok -> Parser (GeneralizedToken CPTok)
forall a b. (a -> b) -> a -> b
$ String -> CPTok
NEWSECTION String
sname})
    Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (GeneralizedToken CPTok) -> Parser (GeneralizedToken CPTok)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do {String
extension <- GenParser Char () String
forall st. GenParser Char st String
extension_line; CPTok -> Parser (GeneralizedToken CPTok)
forall a b st. a -> GenParser b st (GeneralizedToken a)
togtok (CPTok -> Parser (GeneralizedToken CPTok))
-> CPTok -> Parser (GeneralizedToken CPTok)
forall a b. (a -> b) -> a -> b
$ String -> CPTok
EXTENSIONLINE String
extension})
    Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
-> Parser (GeneralizedToken CPTok)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (GeneralizedToken CPTok) -> Parser (GeneralizedToken CPTok)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do {(String, String)
pair <- GenParser Char () (String, String)
forall st. GenParser Char st (String, String)
optionpair; CPTok -> Parser (GeneralizedToken CPTok)
forall a b st. a -> GenParser b st (GeneralizedToken a)
togtok (CPTok -> Parser (GeneralizedToken CPTok))
-> CPTok -> Parser (GeneralizedToken CPTok)
forall a b. (a -> b) -> a -> b
$ (String, String) -> CPTok
NEWOPTION (String, String)
pair})
--    <?> "Invalid syntax in configuration file"

loken :: Parser [GeneralizedToken CPTok]
loken :: Parser [GeneralizedToken CPTok]
loken = do [GeneralizedToken CPTok]
x <- Parser (GeneralizedToken CPTok)
-> GenParser Char () () -> Parser [GeneralizedToken CPTok]
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 Parser (GeneralizedToken CPTok)
iloken GenParser Char () ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
           [GeneralizedToken CPTok] -> Parser [GeneralizedToken CPTok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GeneralizedToken CPTok] -> Parser [GeneralizedToken CPTok])
-> [GeneralizedToken CPTok] -> Parser [GeneralizedToken CPTok]
forall a b. (a -> b) -> a -> b
$ (GeneralizedToken CPTok -> Bool)
-> [GeneralizedToken CPTok] -> [GeneralizedToken CPTok]
forall a. (a -> Bool) -> [a] -> [a]
filter (\y :: GeneralizedToken CPTok
y -> GeneralizedToken CPTok -> CPTok
forall a b. (a, b) -> b
snd GeneralizedToken CPTok
y CPTok -> CPTok -> Bool
forall a. Eq a => a -> a -> Bool
/= CPTok
IGNOREDATA) [GeneralizedToken CPTok]
x