{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- | Parse Dhall tokens. Even though we don't have a tokenizer per-se this
---  module is useful for keeping some small parsing utilities.
module Dhall.Parser.Token (
    endOfLine,
    validCodepoint,
    whitespace,
    lineComment,
    lineCommentPrefix,
    blockComment,
    nonemptyWhitespace,
    bashEnvironmentVariable,
    posixEnvironmentVariable,
    ComponentType(..),
    text,
    char,
    file_,
    label,
    anyLabelOrSome,
    anyLabel,
    labels,
    httpRaw,
    hexdig,
    identifier,
    hexNumber,
    signPrefix,
    doubleLiteral,
    doubleInfinity,
    naturalLiteral,
    integerLiteral,
    dateFullYear,
    dateMonth,
    dateMday,
    timeHour,
    timeMinute,
    timeSecond,
    timeSecFrac,
    _Optional,
    _if,
    _then,
    _else,
    _let,
    _in,
    _as,
    _using,
    _merge,
    _toMap,
    _showConstructor,
    _assert,
    _Some,
    _None,
    _NaturalFold,
    _NaturalBuild,
    _NaturalIsZero,
    _NaturalEven,
    _NaturalOdd,
    _NaturalToInteger,
    _NaturalShow,
    _NaturalSubtract,
    _IntegerClamp,
    _IntegerNegate,
    _IntegerShow,
    _IntegerToDouble,
    _DoubleShow,
    _ListBuild,
    _ListFold,
    _ListLength,
    _ListHead,
    _ListLast,
    _ListIndexed,
    _ListReverse,
    _Bool,
    _Bytes,
    _Natural,
    _Integer,
    _Double,
    _Text,
    _TextReplace,
    _TextShow,
    _Date,
    _DateShow,
    _Time,
    _TimeShow,
    _TimeZone,
    _TimeZoneShow,
    _List,
    _True,
    _False,
    _NaN,
    _Type,
    _Kind,
    _Sort,
    _Location,
    _equal,
    _or,
    _plus,
    _textAppend,
    _listAppend,
    _and,
    _times,
    _doubleEqual,
    _notEqual,
    _dot,
    _openBrace,
    _closeBrace,
    _openBracket,
    _closeBracket,
    _openAngle,
    _closeAngle,
    _bar,
    _comma,
    _openParens,
    _closeParens,
    _colon,
    _at,
    _equivalent,
    _missing,
    _importAlt,
    _combine,
    _combineTypes,
    _prefer,
    _lambda,
    _forall,
    _arrow,
    _doubleColon,
    _with,
    ) where

import Dhall.Parser.Combinators

import Control.Applicative     (Alternative (..), optional)
import Data.Bits               ((.&.))
import Data.Fixed              (Pico)
import Data.Functor            (void, ($>))
import Data.Ratio              ((%))
import Data.Text               (Text)
import Dhall.Syntax
import Text.Parser.Combinators (choice, try, (<?>))

import qualified Control.Monad              as Monad
import qualified Data.Char                  as Char
import qualified Data.Foldable
import qualified Data.HashSet
import qualified Data.List                  as List
import qualified Data.List.NonEmpty
import qualified Data.Scientific            as Scientific
import qualified Data.Text
import qualified Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer
import qualified Text.Parser.Char
import qualified Text.Parser.Combinators
import qualified Text.Parser.Token

import Numeric.Natural (Natural)

-- | Match an end-of-line character sequence
endOfLine :: Parser Text
endOfLine :: Parser Text
endOfLine =
    (   Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\n"  
    Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\r\n"
    ) Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline"

-- | Returns `True` if the given `Int` is a valid Unicode codepoint
validCodepoint :: Int -> Bool
validCodepoint :: Int -> Bool
validCodepoint Int
c =
    Bool -> Bool
not (GeneralCategory
category GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Char.Surrogate
      Bool -> Bool -> Bool
|| Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFFFE Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xFFFE
      Bool -> Bool -> Bool
|| Int
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFFFF Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xFFFF)
  where
    category :: GeneralCategory
category = Char -> GeneralCategory
Char.generalCategory (Int -> Char
Char.chr Int
c)

{-| Parse 0 or more whitespace characters (including comments)

    This corresponds to the @whsp@ rule in the official grammar
-}
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = Parser () -> Parser ()
forall a. Parser a -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
Text.Parser.Combinators.skipMany Parser ()
whitespaceChunk

{-| Parse 1 or more whitespace characters (including comments)

    This corresponds to the @whsp1@ rule in the official grammar
-}
nonemptyWhitespace :: Parser ()
nonemptyWhitespace :: Parser ()
nonemptyWhitespace = Parser () -> Parser ()
forall a. Parser a -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
Text.Parser.Combinators.skipSome Parser ()
whitespaceChunk

alpha :: Char -> Bool
alpha :: Char -> Bool
alpha Char
c = (Char
'\x41' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5A') Bool -> Bool -> Bool
|| (Char
'\x61' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7A')

digit :: Char -> Bool
digit :: Char -> Bool
digit Char
c = Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x39'

alphaNum :: Char -> Bool
alphaNum :: Char -> Bool
alphaNum Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
digit Char
c

{-| Parse a hex digit (uppercase or lowercase)

    This corresponds to the @HEXDIG@ rule in the official grammar
-}
hexdig :: Char -> Bool
hexdig :: Char -> Bool
hexdig Char
c =
        (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
    Bool -> Bool -> Bool
||  (Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')
    Bool -> Bool -> Bool
||  (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')

-- | Parse a leading @+@ or @-@ sign
signPrefix :: Num a => Parser (a -> a)
signPrefix :: forall a. Num a => Parser (a -> a)
signPrefix = (do
    let positive :: Parser (a -> a)
positive = (Char -> a -> a) -> Parser Char -> Parser (a -> a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> a -> a
forall a. a -> a
id    ) (Char -> Parser Char
char Char
'+')
    let negative :: Parser (a -> a)
negative = (Char -> a -> a) -> Parser Char -> Parser (a -> a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> a -> a
forall a. Num a => a -> a
negate) (Char -> Parser Char
char Char
'-')
    Parser (a -> a)
forall {a}. Parser (a -> a)
positive Parser (a -> a) -> Parser (a -> a) -> Parser (a -> a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a -> a)
negative ) Parser (a -> a) -> String -> Parser (a -> a)
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"sign"

{-| Parse a `Dhall.Syntax.Double` literal

    This corresponds to the @double-literal@ rule from the official grammar
-}
doubleLiteral :: Parser Double
doubleLiteral :: Parser Double
doubleLiteral = (do
    -- We don't use `Text.Parser.Token.double` since that consumes trailing
    -- whitespace and there is no whitespace-free alternative.  See:
    --
    -- https://github.com/dhall-lang/dhall-haskell/pull/1646
    -- https://github.com/dhall-lang/dhall-haskell/pull/1647
    --
    -- We also don't use `Text.Megaparsec.Char.Lexer.float` because that
    -- transitively depends on `Data.Char.toTitle` which is broken on older
    -- versions of GHCJS that we still support.  See:
    --
    -- https://github.com/dhall-lang/dhall-haskell/pull/1681
    -- https://github.com/ghcjs/ghcjs-base/issues/62
    --
    -- Also, hand-writing the parser code for `Double` literals helps to better
    -- ensure that we follow the standard exactly as written.
    sign <- Parser (Double -> Double)
forall a. Num a => Parser (a -> a)
signPrefix Parser (Double -> Double)
-> Parser (Double -> Double) -> Parser (Double -> Double)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Double) -> Parser (Double -> Double)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double -> Double
forall a. a -> a
id

    x <- Text.Parser.Token.decimal

    let alternative0 = do
            y <- Parser Scientific
fraction

            e <- exponent' <|> pure 1

            return ((fromInteger x + y) * e)

    let alternative1 = do
            expo <- Parser Scientific
exponent'

            return (fromInteger x * expo)

    n <- alternative0 <|> alternative1

    return (sign (Scientific.toRealFloat n)) ) Parser Double -> String -> Parser Double
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
  where
    fraction :: Parser Scientific
fraction = do
        _ <- Char -> Parser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
'.'

        digits <- some Text.Parser.Char.digit

        let snoc Scientific
y Char
d =
              Scientific
y Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Integer -> Int -> Scientific
Scientific.scientific (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
d)) (Scientific -> Int
Scientific.base10Exponent Scientific
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

        return (List.foldl' snoc 0 digits)

    exponent' :: Parser Scientific
exponent' = do
        _ <- String -> Parser Char
forall (m :: * -> *). CharParsing m => String -> m Char
Text.Parser.Char.oneOf String
"eE"

        sign <- signPrefix <|> pure id

        x <- Text.Parser.Token.decimal

        return (Scientific.scientific 1 (fromInteger (sign x)))

{-| Parse a signed @Infinity@

    This corresponds to the @minus-infinity-literal@ and @plus-infinity-literal@
    rules from the official grammar
-}
doubleInfinity :: Parser Double
doubleInfinity :: Parser Double
doubleInfinity = (do
    let negative :: Parser (Double -> Double)
negative = (Char -> Double -> Double)
-> Parser Char -> Parser (Double -> Double)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> Double -> Double
forall a. Num a => a -> a
negate) (Char -> Parser Char
char Char
'-')
    sign <- Parser (Double -> Double)
negative Parser (Double -> Double)
-> Parser (Double -> Double) -> Parser (Double -> Double)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Double) -> Parser (Double -> Double)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double -> Double
forall a. a -> a
id
    a <- text "Infinity" >> return (1.0/0.0)
    return (sign a) ) Parser Double -> String -> Parser Double
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

{-| Parse an `Dhall.Syntax.Integer` literal

    This corresponds to the @integer-literal@ rule from the official grammar
-}
integerLiteral :: Parser Integer
integerLiteral :: Parser Integer
integerLiteral = (do
    sign <- Parser (Integer -> Integer)
forall a. Num a => Parser (a -> a)
signPrefix
    a    <- naturalLiteral
    return (sign (fromIntegral a)) ) Parser Integer -> String -> Parser Integer
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

{-| Parse a `Dhall.Syntax.Natural` literal

    This corresponds to the @natural-literal@ rule from the official grammar
-}
naturalLiteral :: Parser Natural
naturalLiteral :: Parser Natural
naturalLiteral = (do
    a <-    Parser Natural
binary
        Parser Natural -> Parser Natural -> Parser Natural
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Natural
hexadecimal
        Parser Natural -> Parser Natural -> Parser Natural
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Natural
decimal
        Parser Natural -> Parser Natural -> Parser Natural
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'0' Parser Char -> Natural -> Parser Natural
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Natural
0)
    return a ) Parser Natural -> String -> Parser Natural
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
  where
    binary :: Parser Natural
binary = Parser Natural -> Parser Natural
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Char -> Parser Char
char Char
'0' Parser Char -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
'b' Parser Char -> Parser Natural -> Parser Natural
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Text.Megaparsec.Char.Lexer.binary)
    hexadecimal :: Parser Natural
hexadecimal = Parser Natural -> Parser Natural
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Char -> Parser Char
char Char
'0' Parser Char -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
'x' Parser Char -> Parser Natural -> Parser Natural
forall a b. Parser a -> Parser b -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Text.Megaparsec.Char.Lexer.hexadecimal)
    decimal :: Parser Natural
decimal = do
        n <- Parser Natural
headDigit
        ns <- many tailDigit
        return (mkNum (n:ns))
      where
        headDigit :: Parser Natural
headDigit = (Char -> Bool) -> Parser Natural
forall {m :: * -> *} {b}.
(Monad m, CharParsing m, Num b) =>
(Char -> Bool) -> m b
decimalDigit Char -> Bool
nonZeroDigit Parser Natural -> String -> Parser Natural
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"non-zero digit"
          where
            nonZeroDigit :: Char -> Bool
nonZeroDigit Char
c = Char
'1' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

        tailDigit :: Parser Natural
tailDigit = (Char -> Bool) -> Parser Natural
forall {m :: * -> *} {b}.
(Monad m, CharParsing m, Num b) =>
(Char -> Bool) -> m b
decimalDigit Char -> Bool
digit Parser Natural -> String -> Parser Natural
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"digit"

        decimalDigit :: (Char -> Bool) -> m b
decimalDigit Char -> Bool
predicate = do
            c <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
            return (fromIntegral (Char.ord c - Char.ord '0'))

        mkNum :: [Natural] -> Natural
mkNum = (Natural -> Natural -> Natural) -> Natural -> [Natural] -> Natural
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
step Natural
0
          where
            step :: a -> a -> a
step a
acc a
x = a
acc a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x

{-| Parse a 4-digit year

    This corresponds to the @date-fullyear@ rule from the official grammar
-}
dateFullYear :: Parser Integer
dateFullYear :: Parser Integer
dateFullYear = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
4 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    return (digits `base` 10)

{-| Parse a 2-digit month

    This corresponds to the @date-month@ rule from the official grammar
-}
dateMonth :: Parser Int
dateMonth :: Parser Int
dateMonth = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    let month = String
digits String -> Int -> Int
forall n. Num n => String -> n -> n
`base` Int
10

    if 1 <= month && month <= 12
        then return month
        else fail "Invalid month"

{-| Parse a 2-digit day of the month

    This corresponds to the @date-mday@ rule from the official grammar
-}
dateMday :: Parser Int
dateMday :: Parser Int
dateMday = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    let day = String
digits String -> Int -> Int
forall n. Num n => String -> n -> n
`base` Int
10

    if 1 <= day && day <= 31
        then return day
        else fail "Invalid day"

{-| Parse a 2-digit hour

    This corresponds to the @time-hour@ rule from the official grammar
-}
timeHour :: Parser Int
timeHour :: Parser Int
timeHour = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    let hour = String
digits String -> Int -> Int
forall n. Num n => String -> n -> n
`base` Int
10

    if 0 <= hour && hour < 24
        then return hour
        else fail "Invalid hour"

{-| Parse a 2-digit minute

    This corresponds to the @time-minute@ rule from the official grammar
-}
timeMinute :: Parser Int
timeMinute :: Parser Int
timeMinute = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    let minute = String
digits String -> Int -> Int
forall n. Num n => String -> n -> n
`base` Int
10

    if 0 <= minute && minute < 60
        then return minute
        else fail "Invalid minute"

{-| Parse a 2-digit second

    This corresponds to the @time-second@ rule from the official grammar
-}
timeSecond :: Parser Pico
timeSecond :: Parser Pico
timeSecond = do
    digits <- Int -> Parser Char -> Parser String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    let second = String
digits String -> Pico -> Pico
forall n. Num n => String -> n -> n
`base` Pico
10

    if 0 <= second && second < 60
        then return second
        else fail "Invalid second"

{-| Parse the fractional component of a second

    This corresponds to the @time-secfrac@ rule from the official grammar
-}
timeSecFrac :: Parser (Pico, Word)
timeSecFrac :: Parser (Pico, Word)
timeSecFrac = do
    _ <- Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"."

    digits <- some (Text.Parser.Char.satisfy digit)

    let precision = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits)

    return (fromRational ((digits `base` 10) % (10 ^ precision)), precision)

{-| Parse an identifier (i.e. a variable or built-in)

    Variables can have an optional index to disambiguate shadowed variables

    This corresponds to the @identifier@ rule from the official grammar
-}
identifier :: Parser Var
identifier :: Parser Var
identifier = do
    x <- Parser Text
label

    let indexed = Parser Int -> Parser Int
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ do
            Parser ()
whitespace
            Parser ()
_at
            Parser ()
whitespace
            n <- Parser Natural
naturalLiteral
            return (fromIntegral n)

    n <- indexed <|> pure 0
    return (V x n)

whitespaceChunk :: Parser ()
whitespaceChunk :: Parser ()
whitespaceChunk =
    [Parser ()] -> Parser ()
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile1 Char -> Bool
predicate)
        , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\r\n" Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline")
        , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
lineComment
        , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
blockComment
        ] Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
  where
    predicate :: Char -> Bool
predicate Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'

-- | Parse a hexademical number and convert to the corresponding `Int`
hexNumber :: Parser Int
hexNumber :: Parser Int
hexNumber = [Parser Int] -> Parser Int
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Parser Int
hexDigit, Parser Int
hexUpper, Parser Int
hexLower ]
  where
    hexDigit :: Parser Int
hexDigit = do
        c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        return (Char.ord c - Char.ord '0')
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

    hexUpper :: Parser Int
hexUpper = do
        c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        return (10 + Char.ord c - Char.ord 'A')
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F'

    hexLower :: Parser Int
hexLower = do
        c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        return (10 + Char.ord c - Char.ord 'a')
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f'

-- | Same as `lineComment` except that this doesn't parse the end-of-line
--   character
lineCommentPrefix :: Parser Text
lineCommentPrefix :: Parser Text
lineCommentPrefix = do
    _ <- Text -> Parser Text
text Text
"--"

    let predicate Char
c = (Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF') Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    commentText <- Dhall.Parser.Combinators.takeWhile predicate

    return ("--" <> commentText)

-- | Parse a Dhall's single-line comment, starting from `--` and until the
--   last character of the line /before/ the end-of-line character
lineComment :: Parser Text
lineComment :: Parser Text
lineComment = Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
lineCommentPrefix Parser Text -> Parser Text -> Parser Text
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
endOfLine)

-- | Parsed text doesn't include opening braces
blockComment :: Parser Text
blockComment :: Parser Text
blockComment = do
    _ <- Text -> Parser Text
text Text
"{-"
    c <- blockCommentContinue
    pure ("{-" <> c <> "-}")

blockCommentChunk :: Parser Text
blockCommentChunk :: Parser Text
blockCommentChunk =
    [Parser Text] -> Parser Text
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Parser Text
blockComment  -- Nested block comment
        , Parser Text
characters
        , Parser Text
character
        , Parser Text
endOfLine
        ]
  where
    characters :: Parser Text
characters = ((Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile1 Char -> Bool
predicate)
      where
        predicate :: Char -> Bool
predicate Char
c =
                Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{'
            Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
            Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    character :: Parser Text
character = ((Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.satisfy Char -> Bool
predicate)
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

blockCommentContinue :: Parser Text
blockCommentContinue :: Parser Text
blockCommentContinue = Parser Text
endOfComment Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
continue
  where
    endOfComment :: Parser Text
endOfComment = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
"-}") Parser () -> Parser Text -> Parser Text
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

    continue :: Parser Text
continue = do
        c <- Parser Text
blockCommentChunk
        c' <- blockCommentContinue
        pure (c <> c')

simpleLabel :: Bool -> Parser Text
simpleLabel :: Bool -> Parser Text
simpleLabel Bool
allowReserved = Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
    c    <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
headCharacter
    rest <- Dhall.Parser.Combinators.takeWhile tailCharacter
    let t = Char -> Text -> Text
Data.Text.cons Char
c Text
rest
    let isNotAKeyword = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
t Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Data.HashSet.member` HashSet Text
reservedKeywords
    let isNotAReservedIdentifier = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
t Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Data.HashSet.member` HashSet Text
reservedIdentifiers
    Monad.guard (isNotAKeyword && (allowReserved || isNotAReservedIdentifier))
    return t

headCharacter :: Char -> Bool
headCharacter :: Char -> Bool
headCharacter Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

tailCharacter :: Char -> Bool
tailCharacter :: Char -> Bool
tailCharacter Char
c = Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

backtickLabel :: Parser Text
backtickLabel :: Parser Text
backtickLabel = do
    _ <- Char -> Parser Char
char Char
'`'
    t <- Dhall.Parser.Combinators.takeWhile predicate
    _ <- char '`'
    return t
  where
    predicate :: Char -> Bool
predicate Char
c =
            Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5F'
        Bool -> Bool -> Bool
||  Char
'\x61' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7E'

{-| Parse a braced sequence of comma-separated labels

    For example, this is used to parse the record projection syntax

    This corresponds to the @labels@ rule in the official grammar
-}
labels :: Parser [Text]
labels :: Parser [Text]
labels = do
    Parser ()
_openBrace

    Parser ()
whitespace

    Parser [Text]
nonEmptyLabels Parser [Text] -> Parser [Text] -> Parser [Text]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Text]
forall {a}. Parser [a]
emptyLabels
  where
    emptyLabels :: Parser [a]
emptyLabels = do
        Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeBrace)

        [a] -> Parser [a]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    nonEmptyLabels :: Parser [Text]
nonEmptyLabels = do
        x  <- Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser Text -> Parser Text
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
anyLabelOrSome)

        whitespace

        xs <- many (try (_comma *> whitespace *> anyLabelOrSome) <* whitespace)

        _ <- optional (_comma *> whitespace)

        _closeBrace

        return (x : xs)

{-| Parse a label (e.g. a variable\/field\/alternative name)

    Rejects labels that match built-in names (e.g. @Natural/even@)

    This corresponds to the @nonreserved-label@ rule in the official grammar
-}
label :: Parser Text
label :: Parser Text
label = Parser Text
backtickLabel Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
False Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"label"

{-| Same as `label` except that built-in names are allowed

    This corresponds to the @any-label@ rule in the official grammar
-}
anyLabel :: Parser Text
anyLabel :: Parser Text
anyLabel = (do
    t <- Parser Text
backtickLabel Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
True
    return t ) Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"any label"

{-| Same as `anyLabel` except that `Some` is allowed

    This corresponds to the @any-label-or-some@ rule in the official grammar
-}

anyLabelOrSome :: Parser Text
anyLabelOrSome :: Parser Text
anyLabelOrSome = Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
anyLabel Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
"Some" Text -> Parser () -> Parser Text
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Some)

{-| Parse a valid Bash environment variable name

    This corresponds to the @bash-environment-variable@ rule in the official
    grammar
-}
bashEnvironmentVariable :: Parser Text
bashEnvironmentVariable :: Parser Text
bashEnvironmentVariable = (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate0 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate1)
  where
    predicate0 :: Char -> Bool
predicate0 Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

    predicate1 :: Char -> Bool
predicate1 Char
c = Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

{-| Parse a valid POSIX environment variable name, which permits a wider range
    of characters than a Bash environment variable name

    This corresponds to the @posix-environment-variable@ rule in the official
    grammar
-}
posixEnvironmentVariable :: Parser Text
posixEnvironmentVariable :: Parser Text
posixEnvironmentVariable = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
posixEnvironmentVariableCharacter

posixEnvironmentVariableCharacter :: Parser Text
posixEnvironmentVariableCharacter :: Parser Text
posixEnvironmentVariableCharacter =
    Parser Text
escapeCharacter Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate1
  where
    escapeCharacter :: Parser Text
escapeCharacter = do
        _ <- Char -> Parser Char
char Char
'\\'

        c <- Text.Parser.Char.satisfy (`elem` ("\"\\abfnrtv" :: String))

        case c of
            Char
'"'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\""
            Char
'\\' -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\"
            Char
'a'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\a"
            Char
'b'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\b"
            Char
'f'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\f"
            Char
'n'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
            Char
'r'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\r"
            Char
't'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\t"
            Char
'v'  -> Text -> Parser Text
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\v"
            Char
_    -> Parser Text
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

    predicate1 :: Char -> Bool
predicate1 Char
c =
            (Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x21')
        Bool -> Bool -> Bool
||  (Char
'\x23' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3C')
        Bool -> Bool -> Bool
||  (Char
'\x3E' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5B')
        Bool -> Bool -> Bool
||  (Char
'\x5D' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7E')

quotedPathCharacter :: Char -> Bool
quotedPathCharacter :: Char -> Bool
quotedPathCharacter Char
c =
        (Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x21')
    Bool -> Bool -> Bool
||  (Char
'\x23' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2E')
    Bool -> Bool -> Bool
||  (Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF')

{-| The @pathComponent@ function uses this type to distinguish whether to parse
    a URL path component or a file path component
-}
data ComponentType = URLComponent | FileComponent

-- | Parse a path component
pathComponent :: ComponentType -> Parser Text
pathComponent :: ComponentType -> Parser Text
pathComponent ComponentType
componentType = do
    _ <- Parser Text
"/" :: Parser Text

    let pathData =
            case ComponentType
componentType of
                ComponentType
FileComponent ->
                    Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
Dhall.Syntax.pathCharacter
                ComponentType
URLComponent ->
                    Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star Parser Text
pchar

    let quotedPathData = do
            _ <- Char -> Parser Char
char Char
'"'
            t <- Text.Megaparsec.takeWhile1P Nothing quotedPathCharacter
            _ <- char '"'
            return t

    case componentType of
        ComponentType
FileComponent -> Parser Text
quotedPathData Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pathData
        ComponentType
URLComponent -> Parser Text
pathData

-- | Parse a `File`
file_ :: ComponentType -> Parser File
file_ :: ComponentType -> Parser File
file_ ComponentType
componentType = do
    let emptyPath :: Parser (NonEmpty Text)
emptyPath =
            case ComponentType
componentType of
                ComponentType
URLComponent  -> NonEmpty Text -> Parser (NonEmpty Text)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")
                ComponentType
FileComponent -> Parser (NonEmpty Text)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

    path <- Parser Text -> Parser (NonEmpty Text)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
Data.List.NonEmpty.some1 (ComponentType -> Parser Text
pathComponent ComponentType
componentType) Parser (NonEmpty Text)
-> Parser (NonEmpty Text) -> Parser (NonEmpty Text)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (NonEmpty Text)
emptyPath

    let directory = [Text] -> Directory
Directory ([Text] -> [Text]
forall a. [a] -> [a]
reverse (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
Data.List.NonEmpty.init NonEmpty Text
path))
    let file      = NonEmpty Text -> Text
forall a. NonEmpty a -> a
Data.List.NonEmpty.last NonEmpty Text
path

    return (File {..})

scheme_ :: Parser Scheme
scheme_ :: Parser Scheme
scheme_ =
        (Parser Text
"http" :: Parser Text)
    Parser Text -> Parser Scheme -> Parser Scheme
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  (((Parser Text
"s" :: Parser Text) Parser Text -> Parser Scheme -> Parser Scheme
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scheme -> Parser Scheme
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTPS) Parser Scheme -> Parser Scheme -> Parser Scheme
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scheme -> Parser Scheme
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTP)
    Parser Scheme -> Parser Text -> Parser Scheme
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  (Parser Text
"://" :: Parser Text)

{-| Parse an HTTP(S) URL without trailing whitespace

    This corresponds to the @http-raw@ rule in the official grammar
-}
httpRaw :: Parser URL
httpRaw :: Parser URL
httpRaw = do
    scheme    <- Parser Scheme
scheme_
    authority <- authority_
    path      <- file_ URLComponent
    query     <- optional (("?" :: Parser Text) *> query_)

    let headers = Maybe a
forall a. Maybe a
Nothing

    return (URL {..})

authority_ :: Parser Text
authority_ :: Parser Text
authority_ = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
userinfo Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"@")) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
host Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
port)

userinfo :: Parser Text
userinfo :: Parser Text
userinfo = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncoded)
  where
    predicate :: Char -> Bool
predicate Char
c = Char -> Bool
unreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
subDelims Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

host :: Parser Text
host :: Parser Text
host = [Parser Text] -> Parser Text
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Parser Text
ipLiteral, Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
ipV4Address, Parser Text
domain ]

port :: Parser Text
port :: Parser Text
port = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit)

ipLiteral :: Parser Text
ipLiteral :: Parser Text
ipLiteral = Parser Text
"[" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> (Parser Text
ipV6Address Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
ipVFuture) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"]"

ipVFuture :: Parser Text
ipVFuture :: Parser Text
ipVFuture = Parser Text
"v" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate)
  where
    predicate :: Char -> Bool
predicate Char
c = Char -> Bool
unreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
subDelims Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

ipV6Address :: Parser Text
ipV6Address :: Parser Text
ipV6Address =
    [Parser Text] -> Parser Text
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative0
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative1
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative2
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative3
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative4
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative5
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative6
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative7
        ,     Parser Text
alternative8
        ]
  where
    alternative0 :: Parser Text
alternative0 = Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
6 (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":") Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ls32

    alternative1 :: Parser Text
alternative1 = Parser Text
"::" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
5 (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":") Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ls32

    alternative2 :: Parser Text
alternative2 = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"::" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
4 (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":") Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ls32

    alternative3 :: Parser Text
alternative3 =
            Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
1 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16)))
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
"::"
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
3 (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":")
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
ls32

    alternative4 :: Parser Text
alternative4 =
            Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
2 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16)))
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
"::"
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
2 (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":")
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
ls32

    alternative5 :: Parser Text
alternative5 =
            Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
3 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16)))
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
"::"
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
h16
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
":"
        Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<>  Parser Text
ls32

    alternative6 :: Parser Text
alternative6 =
        Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
4 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16))) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"::" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ls32

    alternative7 :: Parser Text
alternative7 =
        Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
5 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16))) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"::" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16

    alternative8 :: Parser Text
alternative8 =
        Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
0 Int
6 (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16))) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"::"

h16 :: Parser Text
h16 :: Parser Text
h16 = Int -> Int -> Parser Text -> Parser Text
forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
1 Int
3 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig)

ls32 :: Parser Text
ls32 :: Parser Text
ls32 = Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
h16 Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
":" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
h16) Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
ipV4Address

ipV4Address :: Parser Text
ipV4Address :: Parser Text
ipV4Address = Parser Text
decOctet Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
decOctet Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
decOctet Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
decOctet

decOctet :: Parser Text
decOctet :: Parser Text
decOctet =
    [Parser Text] -> Parser Text
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative4
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative3
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative2
        , Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative1
        ,     Parser Text
alternative0
        ]
  where
    alternative0 :: Parser Text
alternative0 = (Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit

    alternative1 :: Parser Text
alternative1 = (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x31' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x39'

    alternative2 :: Parser Text
alternative2 = Parser Text
"1" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
2 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit)

    alternative3 :: Parser Text
alternative3 = Parser Text
"2" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x34'

    alternative4 :: Parser Text
alternative4 = Parser Text
"25" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x35'

domain :: Parser Text
domain :: Parser Text
domain = Parser Text
domainLabel Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star (Parser Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
domainLabel ) Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option Parser Text
"."

domainLabel :: Parser Text
domainLabel :: Parser Text
domainLabel = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
alphaNum_ Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star (Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
"-" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
alphaNum_)
  where
    alphaNum_ :: Parser Text
alphaNum_ = (Char -> Bool) -> Parser Text
satisfy Char -> Bool
alphaNum

pchar :: Parser Text
pchar :: Parser Text
pchar = (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncoded
  where
    predicate :: Char -> Bool
predicate Char
c = Char -> Bool
unreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
subDelims Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'

query_ :: Parser Text
query_ :: Parser Text
query_ = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star (Parser Text
pchar Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate)
  where
    predicate :: Char -> Bool
predicate Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'

pctEncoded :: Parser Text
pctEncoded :: Parser Text
pctEncoded = Parser Text
"%" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
2 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig)

subDelims :: Char -> Bool
subDelims :: Char -> Bool
subDelims Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"!$&'*+;=" :: String)

unreserved :: Char -> Bool
unreserved :: Char -> Bool
unreserved Char
c =
    Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~'

{-| A variation on `Text.Parser.Char.text` that doesn't quote the expected
    in error messages
-}
text :: Data.Text.Text -> Parser Text
text :: Text -> Parser Text
text Text
t = Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
t Parser Text -> String -> Parser Text
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> Text -> String
Data.Text.unpack Text
t
{-# INLINE text #-}

{-| A variation on `Text.Parser.Char.char` that doesn't quote the expected
    token in error messages
-}
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = Char -> Parser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
c Parser Char -> String -> Parser Char
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> [ Char
c ]
{-# INLINE char #-}

reserved :: Data.Text.Text -> Parser ()
reserved :: Text -> Parser ()
reserved Text
x = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
x)

reservedChar :: Char -> Parser ()
reservedChar :: Char -> Parser ()
reservedChar Char
c = Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
c)

builtin :: Data.Text.Text -> Parser ()
builtin :: Text -> Parser ()
builtin Text
x = Text -> Parser ()
reserved Text
x Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"built-in"
{-# INLINE builtin #-}

operator :: Data.Text.Text -> Parser ()
operator :: Text -> Parser ()
operator Text
x = Text -> Parser ()
reserved Text
x Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"operator"
{-# INLINE operator #-}

operatorChar :: Char -> Parser ()
operatorChar :: Char -> Parser ()
operatorChar Char
x = Char -> Parser ()
reservedChar Char
x Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"operator"
{-# INLINE operatorChar #-}

keyword :: Data.Text.Text -> Parser ()
keyword :: Text -> Parser ()
keyword Text
x = Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
x)) Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"keyword"

{-| Parse the @if@ keyword

    This corresponds to the @if@ rule from the official grammar
-}
_if :: Parser ()
_if :: Parser ()
_if = Text -> Parser ()
keyword Text
"if"

{-| Parse the @then@ keyword

    This corresponds to the @then@ rule from the official grammar
-}
_then :: Parser ()
_then :: Parser ()
_then = Text -> Parser ()
keyword Text
"then"

{-| Parse the @else@ keyword

    This corresponds to the @else@ rule from the official grammar
-}
_else :: Parser ()
_else :: Parser ()
_else = Text -> Parser ()
keyword Text
"else"

{-| Parse the @let@ keyword

    This corresponds to the @let@ rule from the official grammar
-}
_let :: Parser ()
_let :: Parser ()
_let = Text -> Parser ()
keyword Text
"let"

{-| Parse the @in@ keyword

    This corresponds to the @in@ rule from the official grammar
-}
_in :: Parser ()
_in :: Parser ()
_in = Text -> Parser ()
keyword Text
"in"

{-| Parse the @as@ keyword

    This corresponds to the @as@ rule from the official grammar
-}
_as :: Parser ()
_as :: Parser ()
_as = Text -> Parser ()
keyword Text
"as"

{-| Parse the @using@ keyword

    This corresponds to the @using@ rule from the official grammar
-}
_using :: Parser ()
_using :: Parser ()
_using = Text -> Parser ()
keyword Text
"using"

{-| Parse the @merge@ keyword

    This corresponds to the @merge@ rule from the official grammar
-}
_merge :: Parser ()
_merge :: Parser ()
_merge = Text -> Parser ()
keyword Text
"merge"

{-| Parse the @toMap@ keyword

    This corresponds to the @toMap@ rule from the official grammar
-}
_toMap :: Parser ()
_toMap :: Parser ()
_toMap = Text -> Parser ()
keyword Text
"toMap"

{-| Parse the @showConstructor@ keyword

    This corresponds to the @showConstructor@ rule from the official grammar
-}
_showConstructor :: Parser ()
_showConstructor :: Parser ()
_showConstructor = Text -> Parser ()
keyword Text
"showConstructor"

{-| Parse the @assert@ keyword

    This corresponds to the @assert@ rule from the official grammar
-}
_assert :: Parser ()
_assert :: Parser ()
_assert = Text -> Parser ()
keyword Text
"assert"

-- | Parse the @with@ keyword
_with :: Parser ()
_with :: Parser ()
_with = Text -> Parser ()
keyword Text
"with"

{-| Parse the @Some@ built-in

    This corresponds to the @Some@ rule from the official grammar
-}
_Some :: Parser ()
_Some :: Parser ()
_Some = Text -> Parser ()
keyword Text
"Some"

{-| Parse the @None@ built-in

    This corresponds to the @None@ rule from the official grammar
-}
_None :: Parser ()
_None :: Parser ()
_None = Text -> Parser ()
builtin Text
"None"

{-| Parse the @Natural/fold@ built-in

    This corresponds to the @Natural-fold@ rule from the official grammar
-}
_NaturalFold :: Parser ()
_NaturalFold :: Parser ()
_NaturalFold = Text -> Parser ()
builtin Text
"Natural/fold"

{-| Parse the @Natural/build@ built-in

    This corresponds to the @Natural-build@ rule from the official grammar
-}
_NaturalBuild :: Parser ()
_NaturalBuild :: Parser ()
_NaturalBuild = Text -> Parser ()
builtin Text
"Natural/build"

{-| Parse the @Natural/isZero@ built-in

    This corresponds to the @Natural-isZero@ rule from the official grammar
-}
_NaturalIsZero :: Parser ()
_NaturalIsZero :: Parser ()
_NaturalIsZero = Text -> Parser ()
builtin Text
"Natural/isZero"

{-| Parse the @Natural/even@ built-in

    This corresponds to the @Natural-even@ rule from the official grammar
-}
_NaturalEven :: Parser ()
_NaturalEven :: Parser ()
_NaturalEven = Text -> Parser ()
builtin Text
"Natural/even"

{-| Parse the @Natural/odd@ built-in

    This corresponds to the @Natural-odd@ rule from the official grammar
-}
_NaturalOdd :: Parser ()
_NaturalOdd :: Parser ()
_NaturalOdd = Text -> Parser ()
builtin Text
"Natural/odd"

{-| Parse the @Natural/toInteger@ built-in

    This corresponds to the @Natural-toInteger@ rule from the official grammar
-}
_NaturalToInteger :: Parser ()
_NaturalToInteger :: Parser ()
_NaturalToInteger = Text -> Parser ()
builtin Text
"Natural/toInteger"

{-| Parse the @Natural/show@ built-in

    This corresponds to the @Natural-show@ rule from the official grammar
-}
_NaturalShow :: Parser ()
_NaturalShow :: Parser ()
_NaturalShow = Text -> Parser ()
builtin Text
"Natural/show"

{-| Parse the @Natural/subtract@ built-in

    This corresponds to the @Natural-subtract@ rule from the official grammar
-}
_NaturalSubtract :: Parser ()
_NaturalSubtract :: Parser ()
_NaturalSubtract = Text -> Parser ()
builtin Text
"Natural/subtract"

{-| Parse the @Integer/clamp@ built-in

    This corresponds to the @Integer-clamp@ rule from the official grammar
-}
_IntegerClamp :: Parser ()
_IntegerClamp :: Parser ()
_IntegerClamp = Text -> Parser ()
builtin Text
"Integer/clamp"

{-| Parse the @Integer/negate@ built-in

    This corresponds to the @Integer-negate@ rule from the official grammar
-}
_IntegerNegate :: Parser ()
_IntegerNegate :: Parser ()
_IntegerNegate = Text -> Parser ()
builtin Text
"Integer/negate"

{-| Parse the @Integer/show@ built-in

    This corresponds to the @Integer-show@ rule from the official grammar
-}
_IntegerShow :: Parser ()
_IntegerShow :: Parser ()
_IntegerShow = Text -> Parser ()
builtin Text
"Integer/show"

{-| Parse the @Integer/toDouble@ built-in

    This corresponds to the @Integer-toDouble@ rule from the official grammar
-}
_IntegerToDouble :: Parser ()
_IntegerToDouble :: Parser ()
_IntegerToDouble = Text -> Parser ()
builtin Text
"Integer/toDouble"

{-| Parse the @Double/show@ built-in

    This corresponds to the @Double-show@ rule from the official grammar
-}
_DoubleShow :: Parser ()
_DoubleShow :: Parser ()
_DoubleShow = Text -> Parser ()
builtin Text
"Double/show"

{-| Parse the @List/build@ built-in

    This corresponds to the @List-build@ rule from the official grammar
-}
_ListBuild :: Parser ()
_ListBuild :: Parser ()
_ListBuild = Text -> Parser ()
builtin Text
"List/build"

{-| Parse the @List/fold@ built-in

    This corresponds to the @List-fold@ rule from the official grammar
-}
_ListFold :: Parser ()
_ListFold :: Parser ()
_ListFold = Text -> Parser ()
builtin Text
"List/fold"

{-| Parse the @List/length@ built-in

    This corresponds to the @List-length@ rule from the official grammar
-}
_ListLength :: Parser ()
_ListLength :: Parser ()
_ListLength = Text -> Parser ()
builtin Text
"List/length"

{-| Parse the @List/head@ built-in

    This corresponds to the @List-head@ rule from the official grammar
-}
_ListHead :: Parser ()
_ListHead :: Parser ()
_ListHead = Text -> Parser ()
builtin Text
"List/head"

{-| Parse the @List/last@ built-in

    This corresponds to the @List-last@ rule from the official grammar
-}
_ListLast :: Parser ()
_ListLast :: Parser ()
_ListLast = Text -> Parser ()
builtin Text
"List/last"

{-| Parse the @List/indexed@ built-in

    This corresponds to the @List-indexed@ rule from the official grammar
-}
_ListIndexed :: Parser ()
_ListIndexed :: Parser ()
_ListIndexed = Text -> Parser ()
builtin Text
"List/indexed"

{-| Parse the @List/reverse@ built-in

    This corresponds to the @List-reverse@ rule from the official grammar
-}
_ListReverse :: Parser ()
_ListReverse :: Parser ()
_ListReverse = Text -> Parser ()
builtin Text
"List/reverse"

{-| Parse the @Bool@ built-in

    This corresponds to the @Bool@ rule from the official grammar
-}
_Bool :: Parser ()
_Bool :: Parser ()
_Bool = Text -> Parser ()
builtin Text
"Bool"

{-| Parse the @Bytes@ built-in

    This corresponds to the @Bytes@ rule from the official grammar
-}
_Bytes :: Parser ()
_Bytes :: Parser ()
_Bytes = Text -> Parser ()
builtin Text
"Bytes"

{-| Parse the @Optional@ built-in

    This corresponds to the @Optional@ rule from the official grammar
-}
_Optional :: Parser ()
_Optional :: Parser ()
_Optional = Text -> Parser ()
builtin Text
"Optional"

{-| Parse the @Natural@ built-in

    This corresponds to the @Natural@ rule from the official grammar
-}
_Natural :: Parser ()
_Natural :: Parser ()
_Natural = Text -> Parser ()
builtin Text
"Natural"

{-| Parse the @Integer@ built-in

    This corresponds to the @Integer@ rule from the official grammar
-}
_Integer :: Parser ()
_Integer :: Parser ()
_Integer = Text -> Parser ()
builtin Text
"Integer"

{-| Parse the @Double@ built-in

    This corresponds to the @Double@ rule from the official grammar
-}
_Double :: Parser ()
_Double :: Parser ()
_Double = Text -> Parser ()
builtin Text
"Double"

{-| Parse the @Text@ built-in

    This corresponds to the @Text@ rule from the official grammar
-}
_Text :: Parser ()
_Text :: Parser ()
_Text = Text -> Parser ()
builtin Text
"Text"

{-| Parse the @Text/replace@ built-in

    This corresponds to the @Text-replace@ rule from the official grammar
-}
_TextReplace :: Parser ()
_TextReplace :: Parser ()
_TextReplace = Text -> Parser ()
builtin Text
"Text/replace"

{-| Parse the @Text/show@ built-in

    This corresponds to the @Text-show@ rule from the official grammar
-}
_TextShow :: Parser ()
_TextShow :: Parser ()
_TextShow = Text -> Parser ()
builtin Text
"Text/show"

{-| Parse the @Date@ bult-in

    This corresponds to the @Date@ rule from the official grammar
-}
_Date :: Parser ()
_Date :: Parser ()
_Date = Text -> Parser ()
builtin Text
"Date"

{-| Parse the @Date/show@ built-in

    This corresponds to the @Date-show@ rule from the official grammar
-}
_DateShow :: Parser ()
_DateShow :: Parser ()
_DateShow = Text -> Parser ()
builtin Text
"Date/show"

{-| Parse the @Time@ bult-in

    This corresponds to the @Time@ rule from the official grammar
-}
_Time :: Parser ()
_Time :: Parser ()
_Time = Text -> Parser ()
builtin Text
"Time"

{-| Parse the @Time/show@ built-in

    This corresponds to the @Time-show@ rule from the official grammar
-}
_TimeShow :: Parser ()
_TimeShow :: Parser ()
_TimeShow = Text -> Parser ()
builtin Text
"Time/show"

{-| Parse the @TimeZone@ bult-in

    This corresponds to the @TimeZone@ rule from the official grammar
-}
_TimeZone :: Parser ()
_TimeZone :: Parser ()
_TimeZone = Text -> Parser ()
builtin Text
"TimeZone"

{-| Parse the @TimeZone/show@ built-in

    This corresponds to the @TimeZone-show@ rule from the official grammar
-}
_TimeZoneShow :: Parser ()
_TimeZoneShow :: Parser ()
_TimeZoneShow = Text -> Parser ()
builtin Text
"TimeZone/show"

{-| Parse the @List@ built-in

    This corresponds to the @List@ rule from the official grammar
-}
_List :: Parser ()
_List :: Parser ()
_List = Text -> Parser ()
builtin Text
"List"

{-| Parse the @True@ built-in

    This corresponds to the @True@ rule from the official grammar
-}
_True :: Parser ()
_True :: Parser ()
_True = Text -> Parser ()
builtin Text
"True"

{-| Parse the @False@ built-in

    This corresponds to the @False@ rule from the official grammar
-}
_False :: Parser ()
_False :: Parser ()
_False = Text -> Parser ()
builtin Text
"False"

{-| Parse a @NaN@ literal

    This corresponds to the @NaN@ rule from the official grammar
-}
_NaN :: Parser ()
_NaN :: Parser ()
_NaN = Text -> Parser ()
builtin Text
"NaN"

{-| Parse the @Type@ built-in

    This corresponds to the @Type@ rule from the official grammar
-}
_Type :: Parser ()
_Type :: Parser ()
_Type = Text -> Parser ()
builtin Text
"Type"

{-| Parse the @Kind@ built-in

    This corresponds to the @Kind@ rule from the official grammar
-}
_Kind :: Parser ()
_Kind :: Parser ()
_Kind = Text -> Parser ()
builtin Text
"Kind"

{-| Parse the @Sort@ built-in

    This corresponds to the @Sort@ rule from the official grammar
-}
_Sort :: Parser ()
_Sort :: Parser ()
_Sort = Text -> Parser ()
builtin Text
"Sort"

{-| Parse the @Location@ keyword

    This corresponds to the @Location@ rule from the official grammar
-}
_Location :: Parser ()
_Location :: Parser ()
_Location = Text -> Parser ()
builtin Text
"Location"

-- | Parse the @=@ symbol
_equal :: Parser ()
_equal :: Parser ()
_equal = Char -> Parser ()
reservedChar Char
'='

-- | Parse the @||@ symbol
_or :: Parser ()
_or :: Parser ()
_or = Text -> Parser ()
operator Text
"||"

-- | Parse the @+@ symbol
_plus :: Parser ()
_plus :: Parser ()
_plus = Char -> Parser ()
operatorChar Char
'+'

-- | Parse the @++@ symbol
_textAppend :: Parser ()
_textAppend :: Parser ()
_textAppend = Text -> Parser ()
operator Text
"++"

-- | Parse the @#@ symbol
_listAppend :: Parser ()
_listAppend :: Parser ()
_listAppend = Char -> Parser ()
operatorChar Char
'#'

-- | Parse the @&&@ symbol
_and :: Parser ()
_and :: Parser ()
_and = Text -> Parser ()
operator Text
"&&"

-- | Parse the @*@ symbol
_times :: Parser ()
_times :: Parser ()
_times = Char -> Parser ()
operatorChar Char
'*'

-- | Parse the @==@ symbol
_doubleEqual :: Parser ()
_doubleEqual :: Parser ()
_doubleEqual = Text -> Parser ()
operator Text
"=="

-- | Parse the @!=@ symbol
_notEqual :: Parser ()
_notEqual :: Parser ()
_notEqual = Text -> Parser ()
operator Text
"!="

-- | Parse the @.@ symbol
_dot :: Parser ()
_dot :: Parser ()
_dot = Char -> Parser ()
operatorChar Char
'.'

-- | Parse the @{@ symbol
_openBrace :: Parser ()
_openBrace :: Parser ()
_openBrace = Char -> Parser ()
reservedChar Char
'{'

-- | Parse the @}@ symbol
_closeBrace :: Parser ()
_closeBrace :: Parser ()
_closeBrace = Char -> Parser ()
reservedChar Char
'}'

-- | Parse the @[@] symbol
_openBracket :: Parser ()
_openBracket :: Parser ()
_openBracket = Char -> Parser ()
reservedChar Char
'['

-- | Parse the @]@ symbol
_closeBracket :: Parser ()
_closeBracket :: Parser ()
_closeBracket = Char -> Parser ()
reservedChar Char
']'

-- | Parse the @<@ symbol
_openAngle :: Parser ()
_openAngle :: Parser ()
_openAngle = Char -> Parser ()
reservedChar Char
'<'

-- | Parse the @>@ symbol
_closeAngle :: Parser ()
_closeAngle :: Parser ()
_closeAngle = Char -> Parser ()
reservedChar Char
'>'

-- | Parse the @|@ symbol
_bar :: Parser ()
_bar :: Parser ()
_bar = Char -> Parser ()
reservedChar Char
'|'

-- | Parse the @,@ symbol
_comma :: Parser ()
_comma :: Parser ()
_comma = Char -> Parser ()
reservedChar Char
',' Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\',\'"

-- | Parse the @(@ symbol
_openParens :: Parser ()
_openParens :: Parser ()
_openParens = Char -> Parser ()
reservedChar Char
'('

-- | Parse the @)@ symbol
_closeParens :: Parser ()
_closeParens :: Parser ()
_closeParens = Char -> Parser ()
reservedChar Char
')'

-- | Parse the @:@ symbol
_colon :: Parser ()
_colon :: Parser ()
_colon = Char -> Parser ()
reservedChar Char
':'

-- | Parse the @\@@ symbol
_at :: Parser ()
_at :: Parser ()
_at = Char -> Parser ()
reservedChar Char
'@' Parser () -> String -> Parser ()
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"@\""

-- | Parse the equivalence symbol (@===@ or @≡@)
_equivalent :: Parser CharacterSet
_equivalent :: Parser CharacterSet
_equivalent =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'≡' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"≡\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"===" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"===")

-- | Parse the @missing@ keyword
_missing :: Parser ()
_missing :: Parser ()
_missing =
        Text -> Parser ()
keyword Text
"missing"
    Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  Parser Char -> Parser ()
forall a. Parser a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy ((Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
tailCharacter)

-- | Parse the @?@ symbol
_importAlt :: Parser ()
_importAlt :: Parser ()
_importAlt = Char -> Parser ()
operatorChar Char
'?'

-- | Parse the record combine operator (@/\\@ or @∧@)
_combine :: Parser CharacterSet
_combine :: Parser CharacterSet
_combine =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'∧' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"∧\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"/\\" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"/\\")

-- | Parse the record type combine operator (@//\\\\@ or @⩓@)
_combineTypes :: Parser CharacterSet
_combineTypes :: Parser CharacterSet
_combineTypes =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⩓' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⩓\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//\\\\" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"//\\\\")

-- | Parse the record \"prefer\" operator (@//@ or @⫽@)
_prefer :: Parser CharacterSet
_prefer :: Parser CharacterSet
_prefer =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⫽' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⫽\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"//")

-- | Parse a lambda (@\\@ or @λ@)
_lambda :: Parser CharacterSet
_lambda :: Parser CharacterSet
_lambda =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'λ' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"λ\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'\\' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\\")

-- | Parse a forall (@forall@ or @∀@)
_forall :: Parser CharacterSet
_forall :: Parser CharacterSet
_forall =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'∀' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"∀\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"forall" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"forall")

-- | Parse a right arrow (@->@ or @→@)
_arrow :: Parser CharacterSet
_arrow :: Parser CharacterSet
_arrow =
        (CharacterSet
Unicode CharacterSet -> Parser Char -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'→' Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"→\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"->" Parser CharacterSet -> String -> Parser CharacterSet
forall a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"->")

-- | Parse a double colon (@::@)
_doubleColon :: Parser ()
_doubleColon :: Parser ()
_doubleColon = Text -> Parser ()
operator Text
"::"