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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
initial forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Char
subsequent forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity String
peculiar)
  where initial :: ParsecT Text u Identity Char
initial    = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~"
        subsequent :: ParsecT Text u Identity Char
subsequent = forall {u}. ParsecT Text u Identity Char
initial forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-.@"
        peculiar :: ParsecT Text u Identity String
peculiar   = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
initial forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
subsequent 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~" 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 = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
                   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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\x" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-.@"
                   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    = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..." forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"->" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ Char
c -> Char
c 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (  (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
initial forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Char
subsequent
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity String
peculiar
          )
  where initial :: ParsecT Text u Identity Char
initial = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
specInit
        specInit :: ParsecT Text u Identity Char
specInit = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*/:<=>?^_~"
        subsequent :: ParsecT Text u Identity Char
subsequent = forall {u}. ParsecT Text u Identity Char
initial forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
specSubsequent
        specSubsequent :: ParsecT Text u Identity Char
specSubsequent = forall {u}. ParsecT Text u Identity Char
expSign forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
".@"
        expSign :: ParsecT Text u Identity Char
expSign = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-"
        symbolElement :: ParsecT Text () Identity Char
symbolElement =  forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\|"
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
hexEscape
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
mnemEscape
                     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'|' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\x" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\a"
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\b' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\b"
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\t' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\t"
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\n' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\n"
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char
'\r' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\r"
        peculiar :: ParsecT Text u Identity String
peculiar =  (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
expSign
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. a -> a -> [a] -> [a]
cons2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
expSign forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u}. ParsecT Text u Identity Char
signSub forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Char
subsequent
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. a -> a -> a -> [a] -> [a]
cons3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
expSign
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u}. ParsecT Text u Identity Char
dotSub
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Char
subsequent
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {a}. a -> a -> [a] -> [a]
cons2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u}. ParsecT Text u Identity Char
dotSub forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Char
subsequent
        dotSub :: ParsecT Text u Identity Char
dotSub = forall {u}. ParsecT Text u Identity Char
signSub forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
        signSub :: ParsecT Text u Identity Char
signSub = forall {u}. ParsecT Text u Identity Char
initial forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
expSign forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: [a]
cs
        cons3 :: a -> a -> a -> [a] -> [a]
cons3 a
a a
b a
c [a]
ds = a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: a
c 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
small forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall {u}. ParsecT Text u Identity Char
small forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall {u}. ParsecT Text u Identity Char
large forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall {u}. ParsecT Text u Identity Char
digit' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = 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 = 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' = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Char
large forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall {u}. ParsecT Text u Identity Char
small forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall {u}. ParsecT Text u Identity Char
large forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall {u}. ParsecT Text u Identity Char
digit' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = 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 = 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' = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {u}. ParsecT Text u Identity Char
large forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Text u Identity Char
small)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall {u}. ParsecT Text u Identity Char
small forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            forall {u}. ParsecT Text u Identity Char
large forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            forall {u}. ParsecT Text u Identity Char
digit' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                            forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))
  where small :: ParsecT Text u Identity Char
small = 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 = 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' = 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 = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidStart
                                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([GeneralCategory] -> ParsecT Text () Identity Char
hasCat [GeneralCategory]
xidStart forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Integer -> Char -> Integer
go Integer
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
* Integer
x forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger (Char -> Int
value Char
d)
        value :: Char -> Int
value Char
c
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z' = Int
0xa forall a. Num a => a -> a -> a
+ (forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'a')
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Int
0xa forall a. Num a => a -> a -> a
+ (forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'A')
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'0'
          | Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x218a' = Int
0xa
          | Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x218b' = Int
0xb
          | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"Unknown letter in number: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)

digitsFor :: Int -> [Char]
digitsFor :: Int -> String
digitsFor Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
10   = forall a. Int -> [a] -> [a]
take Int
n [Char
'0'..Char
'9']
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
36   = forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
10) [Char
'A'..Char
'Z'] forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
10) [Char
'a'..Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']
  | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"Invalid base for parser: " forall a. [a] -> [a] -> [a]
++ 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 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (Int -> String
digitsFor (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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  Integer
n <- ParsecT Text () Identity Integer
decNumber
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
36)
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r'
  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
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0r"
  Integer
n <- ParsecT Text () Identity Integer
decNumber
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
2 Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
36)
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  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 =  (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser (a -> a)
sign 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 = 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 =  (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0x" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0X") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
hexNumber
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0o" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0O") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
octNumber
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0z" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0Z") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
dozNumber
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0b" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0B") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Integer
binNumber
              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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 = 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 (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 = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser (a -> a)
sign 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 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 = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser (a -> a)
sign 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 = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser (a -> a)
sign 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 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 = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser (a -> a)
sign 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq 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
min :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$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
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
Ord, Int -> Location -> String -> String
[Location] -> String -> String
Location -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Location] -> String -> String
$cshowList :: [Location] -> String -> String
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> String -> String
$cshowsPrec :: Int -> 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
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Located a -> Located a -> Bool
$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
Eq, Located a -> Located a -> Bool
Located a -> Located a -> Ordering
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
min :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
>= :: 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
$c< :: forall a. Ord a => Located a -> Located a -> Bool
compare :: Located a -> Located a -> Ordering
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
Ord, Int -> Located a -> String -> String
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
showList :: [Located a] -> String -> String
$cshowList :: forall a. Show a => [Located a] -> String -> String
show :: Located a -> String
$cshow :: forall a. Show a => Located a -> String
showsPrec :: Int -> Located a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> 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 <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  a
result <- Parser a
parser
  SourcePos
end <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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.

-}