module Data.SCargot.Common ( -- $intro
                           -- * Identifier Syntaxes
                             parseR5RSIdent
                           , parseR6RSIdent
                           , parseR7RSIdent
                           , parseXIDIdentStrict
                           , parseXIDIdentGeneral
                           , parseHaskellIdent
                           , parseHaskellVariable
                           , parseHaskellConstructor
                             -- * Numeric Literal Parsers
                           , signed
                           , prefixedNumber
                           , signedPrefixedNumber
                           , binNumber
                           , signedBinNumber
                           , octNumber
                           , signedOctNumber
                           , decNumber
                           , signedDecNumber
                           , dozNumber
                           , signedDozNumber
                           , hexNumber
                           , signedHexNumber
                             -- ** Numeric Literals for Arbitrary Bases
                           , commonLispNumberAnyBase
                           , gnuM4NumberAnyBase
                             -- ** Source locations
                           , Location(..), Located(..), located, dLocation
                           ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative hiding ((<|>), many)
#endif
import           Control.Monad (guard)
import           Data.Char
import           Data.Text (Text)
import qualified Data.Text as T
import           Text.Parsec
import           Text.Parsec.Pos  (newPos)
import           Text.Parsec.Text (Parser)

-- | Parse an identifier according to the R5RS Scheme standard. This
--   will not normalize case, even though the R5RS standard specifies
--   that all identifiers be normalized to lower case first.
--
--   An R5RS identifier is, broadly speaking, alphabetic or numeric
--   and may include various symbols, but no escapes.
parseR5RSIdent :: Parser Text
parseR5RSIdent :: Parser Text
parseR5RSIdent =
  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
initial ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
subsequent ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity String
forall {u}. ParsecT Text u Identity String
peculiar)
  where initial :: ParsecT Text u Identity Char
initial    = ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~"
        subsequent :: ParsecT Text u Identity Char
subsequent = ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
initial ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-.@"
        peculiar :: ParsecT Text u Identity String
peculiar   = String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-" ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..."

hasCategory :: Char -> [GeneralCategory] -> Bool
hasCategory :: Char -> [GeneralCategory] -> Bool
hasCategory Char
c [GeneralCategory]
cs = Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory]
cs

-- | Parse an identifier according to the R6RS Scheme standard. An
--   R6RS identifier may include inline hexadecimal escape sequences
--   so that, for example, @foo@ is equivalent to @f\\x6f;o@, and is
--   more liberal than R5RS as to which Unicode characters it may
--   accept.
parseR6RSIdent :: Parser Text
parseR6RSIdent :: Parser Text
parseR6RSIdent =
  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
initial ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
subsequent ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity String
peculiar)
  where initial :: ParsecT Text () Identity Char
initial = ParsecT Text () Identity Char
constituent ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~" ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
inlineHex
        constituent :: ParsecT Text () Identity Char
constituent = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
                   ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Text () Identity Char
uniClass (\ Char
c -> Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
||
                                        Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
||
                                        Char -> [GeneralCategory] -> Bool
hasCategory Char
c
                                          [ GeneralCategory
NonSpacingMark
                                          , GeneralCategory
LetterNumber
                                          , GeneralCategory
OtherNumber
                                          , GeneralCategory
DashPunctuation
                                          , GeneralCategory
ConnectorPunctuation
                                          , GeneralCategory
OtherPunctuation
                                          , GeneralCategory
PrivateUse
                                          ])
        inlineHex :: ParsecT Text () Identity Char
inlineHex   = (Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Integer -> Char)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\x" ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber ParsecT Text () Identity Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
        subsequent :: ParsecT Text () Identity Char
subsequent  = ParsecT Text () Identity Char
initial ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-.@"
                   ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Text () Identity Char
uniClass (\ Char
c -> Char -> [GeneralCategory] -> Bool
hasCategory Char
c
                                          [ GeneralCategory
DecimalNumber
                                          , GeneralCategory
SpacingCombiningMark
                                          , GeneralCategory
EnclosingMark
                                          ])
        peculiar :: ParsecT Text () Identity String
peculiar    = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..." ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"->" ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
subsequent)
        uniClass :: (Char -> Bool) -> Parser Char
        uniClass :: (Char -> Bool) -> ParsecT Text () Identity Char
uniClass Char -> Bool
sp = (Char -> Bool) -> ParsecT Text () Identity 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. Ord a => a -> a -> Bool
> Char
'\x7f' Bool -> Bool -> Bool
&& Char -> Bool
sp Char
c)

-- | Parse an identifier according to the R7RS Scheme standard. An
--   R7RS identifier, in addition to a typical identifier format,
--   can also be a chunk of text surrounded by vertical bars that
--   can contain spaces and other characters. Unlike R6RS, it does
--   not allow escapes to be included in identifiers unless those
--   identifiers are surrounded by vertical bars.
parseR7RSIdent :: Parser Text
parseR7RSIdent :: Parser Text
parseR7RSIdent =  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (  (:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
initial ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
subsequent
         ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
symbolElement ParsecT Text () Identity String
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
         ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity String
forall {u}. ParsecT Text u Identity String
peculiar
          )
  where initial :: ParsecT Text u Identity Char
initial = ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
specInit
        specInit :: ParsecT Text u Identity Char
specInit = String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~"
        subsequent :: ParsecT Text u Identity Char
subsequent = ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
initial ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
specSubsequent
        specSubsequent :: ParsecT Text u Identity Char
specSubsequent = ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
expSign ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
".@"
        expSign :: ParsecT Text u Identity Char
expSign = String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-"
        symbolElement :: ParsecT Text () Identity Char
symbolElement =  String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\|"
                     ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
hexEscape
                     ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
mnemEscape
                     ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'|' Char
-> ParsecT Text () Identity String -> ParsecT Text () Identity Char
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\|")
        hexEscape :: ParsecT Text () Identity Char
hexEscape = Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Char)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\x" ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber ParsecT Text () Identity Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
        mnemEscape :: ParsecT Text u Identity Char
mnemEscape =  Char
'\a' Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity Char
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\a"
                  ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\b' Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity Char
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\b"
                  ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\t' Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity Char
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\t"
                  ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\n' Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity Char
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\n"
                  ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\r' Char
-> ParsecT Text u Identity String -> ParsecT Text u Identity Char
forall a b.
a -> ParsecT Text u Identity b -> ParsecT Text u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\r"
        peculiar :: ParsecT Text u Identity String
peculiar =  (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
expSign
                ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> String -> String
forall {a}. a -> a -> [a] -> [a]
cons2 (Char -> Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (Char -> String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
expSign ParsecT Text u Identity (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
signSub ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
subsequent
                ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> Char -> String -> String
forall {a}. a -> a -> a -> [a] -> [a]
cons3 (Char -> Char -> Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (Char -> Char -> String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
expSign
                          ParsecT Text u Identity (Char -> Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (Char -> String -> String)
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
                          ParsecT Text u Identity (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
dotSub
                          ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
subsequent
                ParsecT Text u Identity String
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> String -> String
forall {a}. a -> a -> [a] -> [a]
cons2 (Char -> Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (Char -> String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text u Identity (Char -> String -> String)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (String -> String)
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
dotSub ParsecT Text u Identity (String -> String)
-> ParsecT Text u Identity String -> ParsecT Text u Identity String
forall a b.
ParsecT Text u Identity (a -> b)
-> ParsecT Text u Identity a -> ParsecT Text u Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
subsequent
        dotSub :: ParsecT Text u Identity Char
dotSub = ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
signSub ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        signSub :: ParsecT Text u Identity Char
signSub = ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
initial ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall {u}. ParsecT Text u Identity Char
expSign ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
        cons2 :: a -> a -> [a] -> [a]
cons2 a
a a
b [a]
cs   = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cs
        cons3 :: a -> a -> a -> [a] -> [a]
cons3 a
a a
b a
c [a]
ds = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds

-- | Parse a Haskell variable identifier: a sequence of alphanumeric
--   characters, underscores, or single quote that begins with a
--   lower-case letter.
parseHaskellVariable :: Parser Text
parseHaskellVariable :: Parser Text
parseHaskellVariable =
  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
small ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
small ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
large ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
digit' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isLower
        large :: ParsecT Text u Identity Char
large = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isUpper
        digit' :: ParsecT Text u Identity Char
digit' = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit

-- | Parse a Haskell constructor: a sequence of alphanumeric
--   characters, underscores, or single quote that begins with an
--   upper-case letter.
parseHaskellConstructor :: Parser Text
parseHaskellConstructor :: Parser Text
parseHaskellConstructor =
  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
large ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
small ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
large ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
digit' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isLower
        large :: ParsecT Text u Identity Char
large = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isUpper
        digit' :: ParsecT Text u Identity Char
digit' = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit

-- | Parse a Haskell identifer: a sequence of alphanumeric
--   characters, underscores, or a single quote. This matches both
--   variable and constructor names.
parseHaskellIdent :: Parser Text
parseHaskellIdent :: Parser Text
parseHaskellIdent =
  String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
large ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
small)
                  ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
small ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
large ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
digit' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isLower
        large :: ParsecT Text u Identity Char
large = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isUpper
        digit' :: ParsecT Text u Identity Char
digit' = (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit

-- Ensure that a given character has the given Unicode category
hasCat :: [GeneralCategory] -> Parser Char
hasCat :: [GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
cats = (Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> [GeneralCategory] -> Bool)
-> [GeneralCategory] -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> [GeneralCategory] -> Bool
hasCategory [GeneralCategory]
cats)

xidStart :: [GeneralCategory]
xidStart :: [GeneralCategory]
xidStart = [ GeneralCategory
UppercaseLetter
           , GeneralCategory
LowercaseLetter
           , GeneralCategory
TitlecaseLetter
           , GeneralCategory
ModifierLetter
           , GeneralCategory
OtherLetter
           , GeneralCategory
LetterNumber
           ]

xidContinue :: [GeneralCategory]
xidContinue :: [GeneralCategory]
xidContinue = [GeneralCategory]
xidStart [GeneralCategory] -> [GeneralCategory] -> [GeneralCategory]
forall a. [a] -> [a] -> [a]
++ [ GeneralCategory
NonSpacingMark
                          , GeneralCategory
SpacingCombiningMark
                          , GeneralCategory
DecimalNumber
                          , GeneralCategory
ConnectorPunctuation
                          ]

-- | Parse an identifier of unicode characters of the form
--   @<XID_Start> <XID_Continue>*@, which corresponds strongly
--   to the identifiers found in most C-like languages. Note that
--   the @XID_Start@ category does not include the underscore,
--   so @__foo@ is not a valid XID identifier. To parse
--   identifiers that may include leading underscores, use
--   'parseXIDIdentGeneral'.
parseXIDIdentStrict :: Parser Text
parseXIDIdentStrict :: Parser Text
parseXIDIdentStrict = String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidStart
                                  ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidContinue))

-- | Parse an identifier of unicode characters of the form
--   @(<XID_Start> | '_') <XID_Continue>*@, which corresponds
--   strongly to the identifiers found in most C-like languages.
--   Unlike 'parseXIDIdentStrict', this will also accept an
--   underscore as leading character, which corresponds more
--   closely to programming languages like C and Java, but
--   deviates somewhat from the
--   <http://unicode.org/reports/tr31/ Unicode Identifier and
--   Pattern Syntax standard>.
parseXIDIdentGeneral :: Parser Text
parseXIDIdentGeneral :: Parser Text
parseXIDIdentGeneral = String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidStart ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
                                       ParsecT Text () Identity (String -> String)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidContinue))

-- | A helper function for defining parsers for arbitrary-base integers.
--   The first argument will be the base, and the second will be the
--   parser for the individual digits.
number :: Integer -> Parser Char -> Parser Integer
number :: Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
base ParsecT Text () Identity Char
digits = (Integer -> Char -> Integer) -> Integer -> String -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Integer -> Char -> Integer
go Integer
0 (String -> Integer)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
digits
  where go :: Integer -> Char -> Integer
go Integer
x Char
d = Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
value Char
d)
        value :: Char -> Int
value Char
c
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Int
0xa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a')
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Int
0xa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A')
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x218a' = Int
0xa
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x218b' = Int
0xb
          | Bool
otherwise = String -> Int
forall a. HasCallStack => String -> a
error (String
"Unknown letter in number: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)

digitsFor :: Int -> [Char]
digitsFor :: Int -> String
digitsFor Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10   = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n [Char
'0'..Char
'9']
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
36   = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
10) [Char
'A'..Char
'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
10) [Char
'a'..Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String
"Invalid base for parser: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)

anyBase :: Integer -> Parser Integer
anyBase :: Integer -> ParsecT Text () Identity Integer
anyBase Integer
n = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
n (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (Int -> String
digitsFor (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)))

-- | A parser for Common Lisp's arbitrary-base number syntax, of
--   the form @#[base]r[number]@, where the base is given in
--   decimal. Note that this syntax begins with a @#@, which
--   means it might conflict with defined reader macros.
commonLispNumberAnyBase :: Parser Integer
commonLispNumberAnyBase :: ParsecT Text () Identity Integer
commonLispNumberAnyBase = do
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  Integer
n <- ParsecT Text () Identity Integer
decNumber
  Bool -> ParsecT Text () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
36)
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r'
  ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a. Num a => Parser a -> Parser a
signed (Integer -> ParsecT Text () Identity Integer
anyBase Integer
n)

-- | A parser for GNU m4's arbitrary-base number syntax, of
--   the form @0r[base]:[number]@, where the base is given in
--   decimal.
gnuM4NumberAnyBase :: Parser Integer
gnuM4NumberAnyBase :: ParsecT Text () Identity Integer
gnuM4NumberAnyBase = do
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0r"
  Integer
n <- ParsecT Text () Identity Integer
decNumber
  Bool -> ParsecT Text () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
36)
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a. Num a => Parser a -> Parser a
signed (Integer -> ParsecT Text () Identity Integer
anyBase Integer
n)

sign :: Num a => Parser (a -> a)
sign :: forall a. Num a => Parser (a -> a)
sign =  ((a -> a) -> ParsecT Text () Identity (a -> a)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id     ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (a -> a)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')
    ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (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 Text () Identity (a -> a)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. Num a => a -> a
negate ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (a -> a)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (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 Text () Identity (a -> a)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

-- | Given a parser for some kind of numeric literal, this will attempt to
--   parse a leading @+@ or a leading @-@ followed by the numeric literal,
--   and if a @-@ is found, negate that literal.
signed :: Num a => Parser a -> Parser a
signed :: forall a. Num a => Parser a -> Parser a
signed Parser a
p = (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) ((a -> a) -> a -> a)
-> ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (a -> a)
forall a. Num a => Parser (a -> a)
sign ParsecT Text () Identity (a -> a) -> Parser a -> Parser a
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p

-- | Parses a number in the same way as 'prefixedNumber', with an optional
--   leading @+@ or @-@.
signedPrefixedNumber :: Parser Integer
signedPrefixedNumber :: ParsecT Text () Identity Integer
signedPrefixedNumber = ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a. Num a => Parser a -> Parser a
signed ParsecT Text () Identity Integer
prefixedNumber

-- | Parses a number, determining which numeric base to use by examining
--   the literal's prefix: @0x@ for a hexadecimal number, @0z@ for a
--   dozenal number, @0o@ for an octal number, and @0b@ for a binary
--   number (as well as the upper-case versions of the same.) If the
--   base is omitted entirely, then it is treated as a decimal number.
prefixedNumber :: Parser Integer
prefixedNumber :: ParsecT Text () Identity Integer
prefixedNumber =  (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0x" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0X") ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber
              ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0o" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0O") ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
octNumber
              ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0z" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0Z") ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
dozNumber
              ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0b" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0B") ParsecT Text () Identity String
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
binNumber
              ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Integer
decNumber

-- | A parser for non-signed binary numbers
binNumber :: Parser Integer
binNumber :: ParsecT Text () Identity Integer
binNumber = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
2 (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'1')

-- | A parser for signed binary numbers, with an optional leading @+@ or @-@.
signedBinNumber :: Parser Integer
signedBinNumber :: ParsecT Text () Identity Integer
signedBinNumber = ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a. Num a => Parser a -> Parser a
signed ParsecT Text () Identity Integer
binNumber

-- | A parser for non-signed octal numbers
octNumber :: Parser Integer
octNumber :: ParsecT Text () Identity Integer
octNumber = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
8 (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"01234567")

-- | A parser for signed octal numbers, with an optional leading @+@ or @-@.
signedOctNumber :: Parser Integer
signedOctNumber :: ParsecT Text () Identity Integer
signedOctNumber = (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
($) ((Integer -> Integer) -> Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Integer -> Integer)
forall a. Num a => Parser (a -> a)
sign ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Integer
octNumber

-- | A parser for non-signed decimal numbers
decNumber :: Parser Integer
decNumber :: ParsecT Text () Identity Integer
decNumber = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
10 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- | A parser for signed decimal numbers, with an optional leading @+@ or @-@.
signedDecNumber :: Parser Integer
signedDecNumber :: ParsecT Text () Identity Integer
signedDecNumber = (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
($) ((Integer -> Integer) -> Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Integer -> Integer)
forall a. Num a => Parser (a -> a)
sign ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Integer
decNumber

dozDigit :: Parser Char
dozDigit :: ParsecT Text () Identity Char
dozDigit = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"AaBb\x218a\x218b"

-- | A parser for non-signed duodecimal (dozenal) numbers. This understands both
--   the ASCII characters @'a'@ and @'b'@ and the Unicode characters @'\x218a'@ (↊)
--   and @'\x218b'@ (↋) as digits with the decimal values @10@ and @11@
--   respectively.
dozNumber :: Parser Integer
dozNumber :: ParsecT Text () Identity Integer
dozNumber = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
12 ParsecT Text () Identity Char
dozDigit

-- | A parser for signed duodecimal (dozenal) numbers, with an optional leading @+@ or @-@.
signedDozNumber :: Parser Integer
signedDozNumber :: ParsecT Text () Identity Integer
signedDozNumber = (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
($) ((Integer -> Integer) -> Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Integer -> Integer)
forall a. Num a => Parser (a -> a)
sign ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Integer
dozNumber

-- | A parser for non-signed hexadecimal numbers
hexNumber :: Parser Integer
hexNumber :: ParsecT Text () Identity Integer
hexNumber = Integer
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
number Integer
16 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

-- | A parser for signed hexadecimal numbers, with an optional leading @+@ or @-@.
signedHexNumber :: Parser Integer
signedHexNumber :: ParsecT Text () Identity Integer
signedHexNumber = (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
($) ((Integer -> Integer) -> Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Integer -> Integer)
forall a. Num a => Parser (a -> a)
sign ParsecT Text () Identity (Integer -> Integer)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Integer
hexNumber


-- |
data Location = Span !SourcePos !SourcePos
  deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord, Int -> Location -> String -> String
[Location] -> String -> String
Location -> String
(Int -> Location -> String -> String)
-> (Location -> String)
-> ([Location] -> String -> String)
-> Show Location
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Location -> String -> String
showsPrec :: Int -> Location -> String -> String
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> String -> String
showList :: [Location] -> String -> String
Show)

-- | Add support for source locations while parsing S-expressions, as described in this
--   <https://www.reddit.com/r/haskell/comments/4x22f9/labelling_ast_nodes_with_locations/d6cmdy9/ Reddit>
-- thread.
data Located a = At !Location a
  deriving (Located a -> Located a -> Bool
(Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool) -> Eq (Located a)
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Located a -> Located a -> Bool
== :: Located a -> Located a -> Bool
$c/= :: forall a. Eq a => Located a -> Located a -> Bool
/= :: Located a -> Located a -> Bool
Eq, Eq (Located a)
Eq (Located a)
-> (Located a -> Located a -> Ordering)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Located a)
-> (Located a -> Located a -> Located a)
-> Ord (Located a)
Located a -> Located a -> Bool
Located a -> Located a -> Ordering
Located a -> Located a -> Located a
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
forall {a}. Ord a => Eq (Located a)
forall a. Ord a => Located a -> Located a -> Bool
forall a. Ord a => Located a -> Located a -> Ordering
forall a. Ord a => Located a -> Located a -> Located a
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
compare :: Located a -> Located a -> Ordering
$c< :: forall a. Ord a => Located a -> Located a -> Bool
< :: Located a -> Located a -> Bool
$c<= :: forall a. Ord a => Located a -> Located a -> Bool
<= :: Located a -> Located a -> Bool
$c> :: forall a. Ord a => Located a -> Located a -> Bool
> :: Located a -> Located a -> Bool
$c>= :: forall a. Ord a => Located a -> Located a -> Bool
>= :: Located a -> Located a -> Bool
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
min :: Located a -> Located a -> Located a
Ord, Int -> Located a -> String -> String
[Located a] -> String -> String
Located a -> String
(Int -> Located a -> String -> String)
-> (Located a -> String)
-> ([Located a] -> String -> String)
-> Show (Located a)
forall a. Show a => Int -> Located a -> String -> String
forall a. Show a => [Located a] -> String -> String
forall a. Show a => Located a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Located a -> String -> String
showsPrec :: Int -> Located a -> String -> String
$cshow :: forall a. Show a => Located a -> String
show :: Located a -> String
$cshowList :: forall a. Show a => [Located a] -> String -> String
showList :: [Located a] -> String -> String
Show)

-- | Adds a source span to a parser.
located :: Parser a -> Parser (Located a)
located :: forall a. Parser a -> Parser (Located a)
located Parser a
parser = do
  SourcePos
begin <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  a
result <- Parser a
parser
  SourcePos
end <- ParsecT Text () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Located a -> Parser (Located a)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located a -> Parser (Located a))
-> Located a -> Parser (Located a)
forall a b. (a -> b) -> a -> b
$ Location -> a -> Located a
forall a. Location -> a -> Located a
At (SourcePos -> SourcePos -> Location
Span SourcePos
begin SourcePos
end) a
result

-- | A default location value
dLocation :: Location
dLocation :: Location
dLocation = SourcePos -> SourcePos -> Location
Span SourcePos
dPos SourcePos
dPos
  where dPos :: SourcePos
dPos = String -> Int -> Int -> SourcePos
newPos String
"" Int
0 Int
0

{- $intro

This module contains a selection of parsers for different kinds of
identifiers and literals, from which more elaborate parsers can be
assembled. These can afford the user a quick way of building parsers
for different atom types.

-}