{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
{-# OPTIONS -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}
module Text.Parsec.Indentation.Token where

import Control.Monad.Identity
import Data.Char
import Data.List (nub, sort)
import Text.Parsec
import Text.Parsec.Token

import Text.Parsec.Indentation
import Text.Parsec.Indentation.Char (CharIndentStream(..), charIndentStreamParser)

type IndentLanguageDef st = GenLanguageDef (IndentStream (CharIndentStream String)) st Identity

makeIndentLanguageDef :: (Monad m) => GenLanguageDef s st m -> GenLanguageDef (IndentStream (CharIndentStream s)) st m
makeIndentLanguageDef :: GenLanguageDef s st m
-> GenLanguageDef (IndentStream (CharIndentStream s)) st m
makeIndentLanguageDef GenLanguageDef s st m
l = GenLanguageDef s st m
l {
  identStart :: ParsecT (IndentStream (CharIndentStream s)) st m Char
identStart = ParsecT (CharIndentStream s) st m (Char, Indentation)
-> ParsecT (IndentStream (CharIndentStream s)) st m Char
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m t
indentStreamParser (ParsecT s st m Char
-> ParsecT (CharIndentStream s) st m (Char, Indentation)
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m t
-> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser (GenLanguageDef s st m -> ParsecT s st m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
identStart GenLanguageDef s st m
l)),
  identLetter :: ParsecT (IndentStream (CharIndentStream s)) st m Char
identLetter = ParsecT (CharIndentStream s) st m (Char, Indentation)
-> ParsecT (IndentStream (CharIndentStream s)) st m Char
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m t
indentStreamParser (ParsecT s st m Char
-> ParsecT (CharIndentStream s) st m (Char, Indentation)
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m t
-> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser (GenLanguageDef s st m -> ParsecT s st m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
identLetter GenLanguageDef s st m
l)),
  opStart :: ParsecT (IndentStream (CharIndentStream s)) st m Char
opStart = ParsecT (CharIndentStream s) st m (Char, Indentation)
-> ParsecT (IndentStream (CharIndentStream s)) st m Char
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m t
indentStreamParser (ParsecT s st m Char
-> ParsecT (CharIndentStream s) st m (Char, Indentation)
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m t
-> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser (GenLanguageDef s st m -> ParsecT s st m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opStart GenLanguageDef s st m
l)),
  opLetter :: ParsecT (IndentStream (CharIndentStream s)) st m Char
opLetter = ParsecT (CharIndentStream s) st m (Char, Indentation)
-> ParsecT (IndentStream (CharIndentStream s)) st m Char
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m (t, Indentation) -> ParsecT (IndentStream s) u m t
indentStreamParser (ParsecT s st m Char
-> ParsecT (CharIndentStream s) st m (Char, Indentation)
forall (m :: * -> *) s u t.
Monad m =>
ParsecT s u m t
-> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser (GenLanguageDef s st m -> ParsecT s st m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opLetter GenLanguageDef s st m
l))
  }

-- TODO: makeTokenParser :: (Stream (IndentStream s) m Char)
makeTokenParser :: (Stream s m (Char, Indentation))
                => GenLanguageDef (IndentStream s) u m -> GenTokenParser (IndentStream s) u m
makeTokenParser :: GenLanguageDef (IndentStream s) u m
-> GenTokenParser (IndentStream s) u m
makeTokenParser GenLanguageDef (IndentStream s) u m
languageDef
    = TokenParser :: forall s u (m :: * -> *).
ParsecT s u m String
-> (String -> ParsecT s u m ())
-> ParsecT s u m String
-> (String -> ParsecT s u m ())
-> ParsecT s u m Char
-> ParsecT s u m String
-> ParsecT s u m Integer
-> ParsecT s u m Integer
-> ParsecT s u m Double
-> ParsecT s u m (Either Integer Double)
-> ParsecT s u m Integer
-> ParsecT s u m Integer
-> ParsecT s u m Integer
-> (String -> ParsecT s u m String)
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m ()
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> (forall a. ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m String
-> ParsecT s u m String
-> ParsecT s u m String
-> ParsecT s u m String
-> (forall a. ParsecT s u m a -> ParsecT s u m [a])
-> (forall a. ParsecT s u m a -> ParsecT s u m [a])
-> (forall a. ParsecT s u m a -> ParsecT s u m [a])
-> (forall a. ParsecT s u m a -> ParsecT s u m [a])
-> GenTokenParser s u m
TokenParser{ identifier :: ParsecT (IndentStream s) u m String
identifier = ParsecT (IndentStream s) u m String
identifier
                 , reserved :: String -> ParsecT (IndentStream s) u m ()
reserved = String -> ParsecT (IndentStream s) u m ()
reserved
                 , operator :: ParsecT (IndentStream s) u m String
operator = ParsecT (IndentStream s) u m String
operator
                 , reservedOp :: String -> ParsecT (IndentStream s) u m ()
reservedOp = String -> ParsecT (IndentStream s) u m ()
reservedOp

                 , charLiteral :: ParsecT (IndentStream s) u m Char
charLiteral = ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m Char
charLiteral
                 , stringLiteral :: ParsecT (IndentStream s) u m String
stringLiteral = ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
stringLiteral
                 , natural :: ParsecT (IndentStream s) u m Integer
natural = ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m Integer
natural
                 , integer :: ParsecT (IndentStream s) u m Integer
integer = ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m Integer
integer
                 , float :: ParsecT (IndentStream s) u m Double
float = ParsecT (IndentStream s) u m Double
forall s (m :: * -> *) a u.
(Stream s m (Char, Indentation), Fractional a) =>
ParsecT (IndentStream s) u m a
float
                 , naturalOrFloat :: ParsecT (IndentStream s) u m (Either Integer Double)
naturalOrFloat = ParsecT (IndentStream s) u m (Either Integer Double)
forall s (m :: * -> *) b u.
(Stream s m (Char, Indentation), Fractional b) =>
ParsecT (IndentStream s) u m (Either Integer b)
naturalOrFloat
                 , decimal :: ParsecT (IndentStream s) u m Integer
decimal = ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal
                 , hexadecimal :: ParsecT (IndentStream s) u m Integer
hexadecimal = ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
hexadecimal
                 , octal :: ParsecT (IndentStream s) u m Integer
octal = ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
octal

                 , symbol :: String -> ParsecT (IndentStream s) u m String
symbol = String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol
                 , lexeme :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
lexeme = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme
                 , whiteSpace :: ParsecT (IndentStream s) u m ()
whiteSpace = ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m ()
whiteSpace
                 , parens :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
parens = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
parens
                 , braces :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
braces = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
braces
                 , angles :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
angles = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
angles
                 , brackets :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
brackets = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
brackets
                 , squares :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
squares = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
brackets
                 , semi :: ParsecT (IndentStream s) u m String
semi = ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
semi
                 , comma :: ParsecT (IndentStream s) u m String
comma = ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
comma
                 , colon :: ParsecT (IndentStream s) u m String
colon = ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
colon
                 , dot :: ParsecT (IndentStream s) u m String
dot = ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
dot
                 , semiSep :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) u a.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep
                 , semiSep1 :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep1 = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) u a.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep1
                 , commaSep :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) u a.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep
                 , commaSep1 :: forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep1 = forall a.
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) u a.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep1
                 }
    where

    -----------------------------------------------------------
    -- Bracketing
    -----------------------------------------------------------
    parens :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
parens ParsecT (IndentStream s) u m a
p        = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"(") (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
")") ParsecT (IndentStream s) u m a
p
    braces :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
braces ParsecT (IndentStream s) u m a
p        = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"{") (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"}") ParsecT (IndentStream s) u m a
p
    angles :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
angles ParsecT (IndentStream s) u m a
p        = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"<") (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
">") ParsecT (IndentStream s) u m a
p
    brackets :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
brackets ParsecT (IndentStream s) u m a
p      = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"[") (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"]") ParsecT (IndentStream s) u m a
p

    semi :: ParsecT (IndentStream s) u m String
semi            = String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
";"
    comma :: ParsecT (IndentStream s) u m String
comma           = String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
","
    dot :: ParsecT (IndentStream s) u m String
dot             = String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
"."
    colon :: ParsecT (IndentStream s) u m String
colon           = String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
String -> ParsecT (IndentStream s) u m String
symbol String
":"

    commaSep :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep ParsecT (IndentStream s) u m a
p      = ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT (IndentStream s) u m a
p ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
comma
    semiSep :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep ParsecT (IndentStream s) u m a
p       = ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT (IndentStream s) u m a
p ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
semi

    commaSep1 :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
commaSep1 ParsecT (IndentStream s) u m a
p     = ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT (IndentStream s) u m a
p ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
comma
    semiSep1 :: ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m [a]
semiSep1 ParsecT (IndentStream s) u m a
p      = ParsecT (IndentStream s) u m a
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT (IndentStream s) u m a
p ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m String
semi


    -----------------------------------------------------------
    -- Chars & Strings
    -----------------------------------------------------------
    charLiteral :: ParsecT (IndentStream s) u m Char
charLiteral     = ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'')
                                      (Char -> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT (IndentStream s) u m Char
-> String -> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of character")
                                      ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
characterChar )
                    ParsecT (IndentStream s) u m Char
-> String -> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"character"

    characterChar :: ParsecT s u m Char
characterChar   = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
charLetter ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
charEscape
                    ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"literal character"

    charEscape :: ParsecT s u m Char
charEscape      = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'; ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
escapeCode }
    charLetter :: ParsecT s u m Char
charLetter      = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'') Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\') Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\026'))



    stringLiteral :: ParsecT (IndentStream s) u m String
stringLiteral   = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (
                      do{ [Maybe Char]
str <- ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m [Maybe Char]
-> ParsecT (IndentStream s) u m [Maybe Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
                                         ((IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m Char
forall (m :: * -> *) s u a.
Monad m =>
(IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localTokenMode (IndentationRel -> IndentationRel -> IndentationRel
forall a b. a -> b -> a
const IndentationRel
Any) (Char -> ParsecT (IndentStream s) u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT (IndentStream s) u m Char
-> String -> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of string"))
                                         ((IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m [Maybe Char]
-> ParsecT (IndentStream s) u m [Maybe Char]
forall (m :: * -> *) s u a.
Monad m =>
(IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localTokenMode (IndentationRel -> IndentationRel -> IndentationRel
forall a b. a -> b -> a
const IndentationRel
Any) (ParsecT (IndentStream s) u m (Maybe Char)
-> ParsecT (IndentStream s) u m [Maybe Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT (IndentStream s) u m (Maybe Char)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Maybe Char)
stringChar))
                        ; String -> ParsecT (IndentStream s) u m String
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Char -> String -> String)
-> String -> [Maybe Char] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((String -> String)
-> (Char -> String -> String) -> Maybe Char -> String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id (:)) String
"" [Maybe Char]
str)
                        }
                      ParsecT (IndentStream s) u m String
-> String -> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"literal string")

    stringChar :: ParsecT s u m (Maybe Char)
stringChar      =   do{ Char
c <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
stringLetter; Maybe Char -> ParsecT s u m (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c) }
                    ParsecT s u m (Maybe Char)
-> ParsecT s u m (Maybe Char) -> ParsecT s u m (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m (Maybe Char)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Maybe Char)
stringEscape
                    ParsecT s u m (Maybe Char) -> String -> ParsecT s u m (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string character"

    stringLetter :: ParsecT s u m Char
stringLetter    = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\') Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\026'))

    stringEscape :: ParsecT s u m (Maybe Char)
stringEscape    = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
                        ;     do{ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
escapeGap  ; Maybe Char -> ParsecT s u m (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing }
                          ParsecT s u m (Maybe Char)
-> ParsecT s u m (Maybe Char) -> ParsecT s u m (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
escapeEmpty; Maybe Char -> ParsecT s u m (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing }
                          ParsecT s u m (Maybe Char)
-> ParsecT s u m (Maybe Char) -> ParsecT s u m (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ Char
esc <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
escapeCode; Maybe Char -> ParsecT s u m (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
esc) }
                        }

    escapeEmpty :: ParsecT s u m Char
escapeEmpty     = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&'
    escapeGap :: ParsecT s u m Char
escapeGap       = do{ ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                        ; Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of string gap"
                        }



    -- escape codes
    escapeCode :: ParsecT s u m Char
escapeCode      = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
charEsc ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) b u.
(Stream s m Char, Enum b) =>
ParsecT s u m b
charNum ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
charAscii ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) b u.
(Stream s m Char, Enum b) =>
ParsecT s u m b
charControl
                    ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"escape code"

    charControl :: ParsecT s u m b
charControl     = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
                        ; Char
code <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper
                        ; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (Indentation -> b
forall a. Enum a => Indentation -> a
toEnum (Char -> Indentation
forall a. Enum a => a -> Indentation
fromEnum Char
code Indentation -> Indentation -> Indentation
forall a. Num a => a -> a -> a
- Char -> Indentation
forall a. Enum a => a -> Indentation
fromEnum Char
'A'))
                        }

    charNum :: ParsecT s u m b
charNum         = do{ Integer
code <- ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal
                                  ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'o'; Integer -> ParsecT s u m Char -> ParsecT s u m Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
8 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit }
                                  ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x'; Integer -> ParsecT s u m Char -> ParsecT s u m Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
16 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit }
                        ; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (Indentation -> b
forall a. Enum a => Indentation -> a
toEnum (Integer -> Indentation
forall a. Num a => Integer -> a
fromInteger Integer
code))
                        }

    charEsc :: ParsecT s u m Char
charEsc         = [ParsecT s u m Char] -> ParsecT s u m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (((Char, Char) -> ParsecT s u m Char)
-> [(Char, Char)] -> [ParsecT s u m Char]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> ParsecT s u m Char
forall s (m :: * -> *) b u.
Stream s m Char =>
(Char, b) -> ParsecT s u m b
parseEsc [(Char, Char)]
escMap)
                    where
                      parseEsc :: (Char, b) -> ParsecT s u m b
parseEsc (Char
c,b
code)     = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c; b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
code }

    charAscii :: ParsecT s u m Char
charAscii       = [ParsecT s u m Char] -> ParsecT s u m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (((String, Char) -> ParsecT s u m Char)
-> [(String, Char)] -> [ParsecT s u m Char]
forall a b. (a -> b) -> [a] -> [b]
map (String, Char) -> ParsecT s u m Char
forall s (m :: * -> *) a u.
Stream s m Char =>
(String, a) -> ParsecT s u m a
parseAscii [(String, Char)]
asciiMap)
                    where
                      parseAscii :: (String, a) -> ParsecT s u m a
parseAscii (String
asc,a
code) = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do{ String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
asc; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
code })


    -- escape code tables
    escMap :: [(Char, Char)]
escMap          = String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
"abfnrtv\\\"\'") (String
"\a\b\f\n\r\t\v\\\"\'")
    asciiMap :: [(String, Char)]
asciiMap        = [String] -> String -> [(String, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
ascii3codes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ascii2codes) (String
ascii3 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ascii2)

    ascii2codes :: [String]
ascii2codes     = [String
"BS",String
"HT",String
"LF",String
"VT",String
"FF",String
"CR",String
"SO",String
"SI",String
"EM",
                       String
"FS",String
"GS",String
"RS",String
"US",String
"SP"]
    ascii3codes :: [String]
ascii3codes     = [String
"NUL",String
"SOH",String
"STX",String
"ETX",String
"EOT",String
"ENQ",String
"ACK",String
"BEL",
                       String
"DLE",String
"DC1",String
"DC2",String
"DC3",String
"DC4",String
"NAK",String
"SYN",String
"ETB",
                       String
"CAN",String
"SUB",String
"ESC",String
"DEL"]

    ascii2 :: String
ascii2          = [Char
'\BS',Char
'\HT',Char
'\LF',Char
'\VT',Char
'\FF',Char
'\CR',Char
'\SO',Char
'\SI',
                       Char
'\EM',Char
'\FS',Char
'\GS',Char
'\RS',Char
'\US',Char
'\SP']
    ascii3 :: String
ascii3          = [Char
'\NUL',Char
'\SOH',Char
'\STX',Char
'\ETX',Char
'\EOT',Char
'\ENQ',Char
'\ACK',
                       Char
'\BEL',Char
'\DLE',Char
'\DC1',Char
'\DC2',Char
'\DC3',Char
'\DC4',Char
'\NAK',
                       Char
'\SYN',Char
'\ETB',Char
'\CAN',Char
'\SUB',Char
'\ESC',Char
'\DEL']


    -----------------------------------------------------------
    -- Numbers
    -----------------------------------------------------------
    naturalOrFloat :: ParsecT (IndentStream s) u m (Either Integer b)
naturalOrFloat  = ParsecT (IndentStream s) u m (Either Integer b)
-> ParsecT (IndentStream s) u m (Either Integer b)
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m (Either Integer b)
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m (Either Integer b)
natFloat) ParsecT (IndentStream s) u m (Either Integer b)
-> String -> ParsecT (IndentStream s) u m (Either Integer b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"number"

    float :: ParsecT (IndentStream s) u m a
float           = ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme ParsecT (IndentStream s) u m a
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m b
floating   ParsecT (IndentStream s) u m a
-> String -> ParsecT (IndentStream s) u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float"
    integer :: ParsecT (IndentStream s) u m Integer
integer         = ParsecT (IndentStream s) u m Integer
-> ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m Integer
int        ParsecT (IndentStream s) u m Integer
-> String -> ParsecT (IndentStream s) u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"integer"
    natural :: ParsecT (IndentStream s) u m Integer
natural         = ParsecT (IndentStream s) u m Integer
-> ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
nat        ParsecT (IndentStream s) u m Integer
-> String -> ParsecT (IndentStream s) u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"natural"


    -- floats
    floating :: ParsecT s u m b
floating        = do{ Integer
n <- ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal
                        ; Integer -> ParsecT s u m b
forall s (m :: * -> *) a u.
(Stream s m Char, Fractional a) =>
Integer -> ParsecT s u m a
fractExponent Integer
n
                        }


    natFloat :: ParsecT s u m (Either Integer b)
natFloat        = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'
                        ; ParsecT s u m (Either Integer b)
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m (Either Integer b)
zeroNumFloat
                        }
                      ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m (Either Integer b)
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m (Either Integer b)
decimalFloat

    zeroNumFloat :: ParsecT s u m (Either Integer b)
zeroNumFloat    =  do{ Integer
n <- ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
hexadecimal ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
octal
                         ; Either Integer b -> ParsecT s u m (Either Integer b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either Integer b
forall a b. a -> Either a b
Left Integer
n)
                         }
                    ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m (Either Integer b)
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m (Either Integer b)
decimalFloat
                    ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT s u m (Either Integer b)
forall s (m :: * -> *) b u a.
(Stream s m Char, Fractional b) =>
Integer -> ParsecT s u m (Either a b)
fractFloat Integer
0
                    ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Either Integer b -> ParsecT s u m (Either Integer b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Either Integer b
forall a b. a -> Either a b
Left Integer
0)

    decimalFloat :: ParsecT s u m (Either Integer b)
decimalFloat    = do{ Integer
n <- ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal
                        ; Either Integer b
-> ParsecT s u m (Either Integer b)
-> ParsecT s u m (Either Integer b)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Integer -> Either Integer b
forall a b. a -> Either a b
Left Integer
n)
                                 (Integer -> ParsecT s u m (Either Integer b)
forall s (m :: * -> *) b u a.
(Stream s m Char, Fractional b) =>
Integer -> ParsecT s u m (Either a b)
fractFloat Integer
n)
                        }

    fractFloat :: Integer -> ParsecT s u m (Either a b)
fractFloat Integer
n    = do{ b
f <- Integer -> ParsecT s u m b
forall s (m :: * -> *) a u.
(Stream s m Char, Fractional a) =>
Integer -> ParsecT s u m a
fractExponent Integer
n
                        ; Either a b -> ParsecT s u m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either a b
forall a b. b -> Either a b
Right b
f)
                        }

    fractExponent :: Integer -> ParsecT s u m a
fractExponent Integer
n = do{ a
fract <- ParsecT s u m a
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m b
fraction
                        ; a
expo  <- a -> ParsecT s u m a -> ParsecT s u m a
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option a
1.0 ParsecT s u m a
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m b
exponent'
                        ; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
fract)a -> a -> a
forall a. Num a => a -> a -> a
*a
expo)
                        }
                    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      do{ a
expo <- ParsecT s u m a
forall s (m :: * -> *) b u.
(Stream s m Char, Fractional b) =>
ParsecT s u m b
exponent'
                        ; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n)a -> a -> a
forall a. Num a => a -> a -> a
*a
expo)
                        }

    fraction :: ParsecT s u m a
fraction        = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
                        ; String
digits <- ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"fraction"
                        ; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> a -> a) -> a -> String -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> a -> a
forall a. Fractional a => Char -> a -> a
op a
0.0 String
digits)
                        }
                      ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"fraction"
                    where
                      op :: Char -> a -> a
op Char
d a
f    = (a
f a -> a -> a
forall a. Num a => a -> a -> a
+ Indentation -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Indentation
digitToInt Char
d))a -> a -> a
forall a. Fractional a => a -> a -> a
/a
10.0

    exponent' :: ParsecT s u m a
exponent'       = do{ String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
                        ; Integer -> Integer
f <- ParsecT s u m (Integer -> Integer)
forall s (m :: * -> *) a u.
(Stream s m Char, Num a) =>
ParsecT s u m (a -> a)
sign
                        ; Integer
e <- ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal ParsecT s u m Integer -> String -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"exponent"
                        ; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall b p. (Fractional p, Integral b) => b -> p
power (Integer -> Integer
f Integer
e))
                        }
                      ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"exponent"
                    where
                       power :: b -> p
power b
e  | b
e b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0      = p
1.0p -> p -> p
forall a. Fractional a => a -> a -> a
/b -> p
power(-b
e)
                                | Bool
otherwise  = Integer -> p
forall a. Num a => Integer -> a
fromInteger (Integer
10Integer -> b -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^b
e)


    -- integers and naturals
    int :: ParsecT (IndentStream s) u m Integer
int             = do{ Integer -> Integer
f <- ParsecT (IndentStream s) u m (Integer -> Integer)
-> ParsecT (IndentStream s) u m (Integer -> Integer)
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme ParsecT (IndentStream s) u m (Integer -> Integer)
forall s (m :: * -> *) a u.
(Stream s m Char, Num a) =>
ParsecT s u m (a -> a)
sign
                        ; Integer
n <- ParsecT (IndentStream s) u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
nat
                        ; Integer -> ParsecT (IndentStream s) u m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer
f Integer
n)
                        }

    sign :: ParsecT s u m (a -> a)
sign            =   (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s u m Char
-> ParsecT s u m (a -> a) -> ParsecT s u m (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> ParsecT s u m (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. Num a => a -> a
negate)
                    ParsecT s u m (a -> a)
-> ParsecT s u m (a -> a) -> ParsecT s u m (a -> a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT s u m Char
-> ParsecT s u m (a -> a) -> ParsecT s u m (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> ParsecT s u m (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id)
                    ParsecT s u m (a -> a)
-> ParsecT s u m (a -> a) -> ParsecT s u m (a -> a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (a -> a) -> ParsecT s u m (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id

    nat :: ParsecT s u m Integer
nat             = ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
zeroNumber ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal

    zeroNumber :: ParsecT s u m Integer
zeroNumber      = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'
                        ; ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
hexadecimal ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
octal ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Integer
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Integer
decimal ParsecT s u m Integer
-> ParsecT s u m Integer -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT s u m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
                        }
                      ParsecT s u m Integer -> String -> ParsecT s u m Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
""

    decimal :: ParsecT s u m Integer
decimal         = Integer -> ParsecT s u m Char -> ParsecT s u m Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
10 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    hexadecimal :: ParsecT s u m Integer
hexadecimal     = do{ String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX"; Integer -> ParsecT s u m Char -> ParsecT s u m Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
16 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit }
    octal :: ParsecT s u m Integer
octal           = do{ String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"oO"; Integer -> ParsecT s u m Char -> ParsecT s u m Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
8 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit  }

    number :: Integer -> ParsecT s u m Char -> ParsecT s u m Integer
number Integer
base ParsecT s u m Char
baseDigit
        = do{ String
digits <- ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
baseDigit
            ; let n :: Integer
n = (Integer -> Char -> Integer) -> Integer -> String -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
x Char
d -> Integer
baseInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Indentation -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Indentation
digitToInt Char
d)) Integer
0 String
digits
            ; Integer -> ParsecT s u m Integer -> ParsecT s u m Integer
seq Integer
n (Integer -> ParsecT s u m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n)
            }

    -----------------------------------------------------------
    -- Operators & reserved ops
    -----------------------------------------------------------
    reservedOp :: String -> ParsecT (IndentStream s) u m ()
reservedOp String
name =
        ParsecT (IndentStream s) u m () -> ParsecT (IndentStream s) u m ()
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m ()
 -> ParsecT (IndentStream s) u m ())
-> ParsecT (IndentStream s) u m ()
-> ParsecT (IndentStream s) u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT (IndentStream s) u m () -> ParsecT (IndentStream s) u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT (IndentStream s) u m ()
 -> ParsecT (IndentStream s) u m ())
-> ParsecT (IndentStream s) u m ()
-> ParsecT (IndentStream s) u m ()
forall a b. (a -> b) -> a -> b
$
        do{ String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
          ; ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opLetter GenLanguageDef (IndentStream s) u m
languageDef) ParsecT (IndentStream s) u m ()
-> String -> ParsecT (IndentStream s) u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"end of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name)
          }

    operator :: ParsecT (IndentStream s) u m String
operator =
        ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m String
 -> ParsecT (IndentStream s) u m String)
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall a b. (a -> b) -> a -> b
$ ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT (IndentStream s) u m String
 -> ParsecT (IndentStream s) u m String)
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall a b. (a -> b) -> a -> b
$
        do{ String
name <- ParsecT (IndentStream s) u m String
oper
          ; if (String -> Bool
isReservedOp String
name)
             then String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
"reserved operator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name)
             else String -> ParsecT (IndentStream s) u m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
          }

    oper :: ParsecT (IndentStream s) u m String
oper =
        do{ Char
c <- (GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opStart GenLanguageDef (IndentStream s) u m
languageDef)
          ; String
cs <- ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opLetter GenLanguageDef (IndentStream s) u m
languageDef)
          ; String -> ParsecT (IndentStream s) u m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
          }
        ParsecT (IndentStream s) u m String
-> String -> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"operator"

    isReservedOp :: String -> Bool
isReservedOp String
name =
        [String] -> String -> Bool
forall a. Ord a => [a] -> a -> Bool
isReserved ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort (GenLanguageDef (IndentStream s) u m -> [String]
forall s u (m :: * -> *). GenLanguageDef s u m -> [String]
reservedOpNames GenLanguageDef (IndentStream s) u m
languageDef)) String
name


    -----------------------------------------------------------
    -- Identifiers & Reserved words
    -----------------------------------------------------------
    reserved :: String -> ParsecT (IndentStream s) u m ()
reserved String
name =
        ParsecT (IndentStream s) u m () -> ParsecT (IndentStream s) u m ()
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m ()
 -> ParsecT (IndentStream s) u m ())
-> ParsecT (IndentStream s) u m ()
-> ParsecT (IndentStream s) u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT (IndentStream s) u m () -> ParsecT (IndentStream s) u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT (IndentStream s) u m ()
 -> ParsecT (IndentStream s) u m ())
-> ParsecT (IndentStream s) u m ()
-> ParsecT (IndentStream s) u m ()
forall a b. (a -> b) -> a -> b
$
        do{ String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
caseString String
name
          ; ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
identLetter GenLanguageDef (IndentStream s) u m
languageDef) ParsecT (IndentStream s) u m ()
-> String -> ParsecT (IndentStream s) u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"end of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name)
          }

    caseString :: String -> ParsecT s u m String
caseString String
name
        | GenLanguageDef (IndentStream s) u m -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
caseSensitive GenLanguageDef (IndentStream s) u m
languageDef  = String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
        | Bool
otherwise               = do{ String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
walk String
name; String -> ParsecT s u m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name }
        where
          walk :: String -> ParsecT s u m ()
walk []     = () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          walk (Char
c:String
cs) = do{ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
caseChar Char
c ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
msg; String -> ParsecT s u m ()
walk String
cs }

          caseChar :: Char -> ParsecT s u m Char
caseChar Char
c  | Char -> Bool
isAlpha Char
c  = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toLower Char
c) ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toUpper Char
c)
                      | Bool
otherwise  = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c

          msg :: String
msg         = String -> String
forall a. Show a => a -> String
show String
name


    identifier :: ParsecT (IndentStream s) u m String
identifier =
        ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (ParsecT (IndentStream s) u m String
 -> ParsecT (IndentStream s) u m String)
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall a b. (a -> b) -> a -> b
$ ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT (IndentStream s) u m String
 -> ParsecT (IndentStream s) u m String)
-> ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall a b. (a -> b) -> a -> b
$
        do{ String
name <- ParsecT (IndentStream s) u m String
ident
          ; if (String -> Bool
isReservedName String
name)
             then String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
"reserved word " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name)
             else String -> ParsecT (IndentStream s) u m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
          }


    ident :: ParsecT (IndentStream s) u m String
ident
        = do{ Char
c <- GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
identStart GenLanguageDef (IndentStream s) u m
languageDef
            ; String
cs <- ParsecT (IndentStream s) u m Char
-> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (GenLanguageDef (IndentStream s) u m
-> ParsecT (IndentStream s) u m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
identLetter GenLanguageDef (IndentStream s) u m
languageDef)
            ; String -> ParsecT (IndentStream s) u m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
            }
        ParsecT (IndentStream s) u m String
-> String -> ParsecT (IndentStream s) u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"identifier"

    isReservedName :: String -> Bool
isReservedName String
name
        = [String] -> String -> Bool
forall a. Ord a => [a] -> a -> Bool
isReserved [String]
theReservedNames String
caseName
        where
          caseName :: String
caseName      | GenLanguageDef (IndentStream s) u m -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
caseSensitive GenLanguageDef (IndentStream s) u m
languageDef  = String
name
                        | Bool
otherwise               = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name


    isReserved :: [a] -> a -> Bool
isReserved [a]
names a
name
        = [a] -> Bool
scan [a]
names
        where
          scan :: [a] -> Bool
scan []       = Bool
False
          scan (a
r:[a]
rs)   = case (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
r a
name) of
                            Ordering
LT  -> [a] -> Bool
scan [a]
rs
                            Ordering
EQ  -> Bool
True
                            Ordering
GT  -> Bool
False

    theReservedNames :: [String]
theReservedNames
        | GenLanguageDef (IndentStream s) u m -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
caseSensitive GenLanguageDef (IndentStream s) u m
languageDef  = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
reserved
        | Bool
otherwise                  = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
reserved
        where
          reserved :: [String]
reserved = GenLanguageDef (IndentStream s) u m -> [String]
forall s u (m :: * -> *). GenLanguageDef s u m -> [String]
reservedNames GenLanguageDef (IndentStream s) u m
languageDef



    -----------------------------------------------------------
    -- White space & symbols
    -----------------------------------------------------------
    symbol :: String -> ParsecT (IndentStream s) u m String
symbol String
name
        = ParsecT (IndentStream s) u m String
-> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u b.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme (String -> ParsecT (IndentStream s) u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name)

    lexeme :: ParsecT (IndentStream s) u m b -> ParsecT (IndentStream s) u m b
lexeme ParsecT (IndentStream s) u m b
p
        = do{ b
x <- ParsecT (IndentStream s) u m b
p; ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u.
Stream s m (Char, Indentation) =>
ParsecT (IndentStream s) u m ()
whiteSpace; b -> ParsecT (IndentStream s) u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x  }

    whiteSpace :: ParsecT (IndentStream s) u m ()
whiteSpace = ParsecT (IndentStream s) u m () -> ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u a.
Monad m =>
ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
ignoreAbsoluteIndentation ((IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m ()
-> ParsecT (IndentStream s) u m ()
forall (m :: * -> *) s u a.
Monad m =>
(IndentationRel -> IndentationRel)
-> ParsecT (IndentStream s) u m a -> ParsecT (IndentStream s) u m a
localTokenMode (IndentationRel -> IndentationRel -> IndentationRel
forall a b. a -> b -> a
const IndentationRel
Any) ParsecT (IndentStream s) u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
whiteSpace')
    whiteSpace' :: ParsecT s u m ()
whiteSpace'
        | Bool
noLine Bool -> Bool -> Bool
&& Bool
noMulti  = ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
simpleSpace ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"")
        | Bool
noLine             = ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
simpleSpace ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
multiLineComment ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"")
        | Bool
noMulti            = ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
simpleSpace ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
oneLineComment ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"")
        | Bool
otherwise          = ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
simpleSpace ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
oneLineComment ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
multiLineComment ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"")
        where
          noLine :: Bool
noLine  = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentLine GenLanguageDef (IndentStream s) u m
languageDef)
          noMulti :: Bool
noMulti = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentStart GenLanguageDef (IndentStream s) u m
languageDef)

    simpleSpace :: ParsecT s u m ()
simpleSpace =
        ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace)

    oneLineComment :: ParsecT s u m ()
oneLineComment =
        do{ ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentLine GenLanguageDef (IndentStream s) u m
languageDef))
          ; ParsecT s u m Char -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
          ; () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          }

    multiLineComment :: ParsecT s u m ()
multiLineComment =
        do { ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentStart GenLanguageDef (IndentStream s) u m
languageDef))
           ; ParsecT s u m ()
inComment
           }

    inComment :: ParsecT s u m ()
inComment
        | GenLanguageDef (IndentStream s) u m -> Bool
forall s u (m :: * -> *). GenLanguageDef s u m -> Bool
nestedComments GenLanguageDef (IndentStream s) u m
languageDef  = ParsecT s u m ()
inCommentMulti
        | Bool
otherwise                = ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
inCommentSingle

    inCommentMulti :: ParsecT s u m ()
inCommentMulti
        =   do{ ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentEnd GenLanguageDef (IndentStream s) u m
languageDef)) ; () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
        ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ ParsecT s u m ()
multiLineComment                     ; ParsecT s u m ()
inCommentMulti }
        ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
startEnd)          ; ParsecT s u m ()
inCommentMulti }
        ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
startEnd                       ; ParsecT s u m ()
inCommentMulti }
        ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of comment"
        where
          startEnd :: String
startEnd   = String -> String
forall a. Eq a => [a] -> [a]
nub (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentEnd GenLanguageDef (IndentStream s) u m
languageDef String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentStart GenLanguageDef (IndentStream s) u m
languageDef)

    inCommentSingle :: ParsecT s u m ()
inCommentSingle
        =   do{ ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentEnd GenLanguageDef (IndentStream s) u m
languageDef)); () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
        ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
startEnd)         ; ParsecT s u m ()
inCommentSingle }
        ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do{ String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
startEnd                      ; ParsecT s u m ()
inCommentSingle }
        ParsecT s u m () -> String -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"end of comment"
        where
          startEnd :: String
startEnd   = String -> String
forall a. Eq a => [a] -> [a]
nub (GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentEnd GenLanguageDef (IndentStream s) u m
languageDef String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenLanguageDef (IndentStream s) u m -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
commentStart GenLanguageDef (IndentStream s) u m
languageDef)