{-# 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 =
    (   forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\n"  
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\r\n"
    ) 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 forall a. Eq a => a -> a -> Bool
== GeneralCategory
Char.Surrogate
      Bool -> Bool -> Bool
|| Int
c forall a. Bits a => a -> a -> a
.&. Int
0xFFFE forall a. Eq a => a -> a -> Bool
== Int
0xFFFE
      Bool -> Bool -> Bool
|| Int
c forall a. Bits a => a -> a -> a
.&. Int
0xFFFF 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 = 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 = 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x5A') Bool -> Bool -> Bool
|| (Char
'\x61' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x7A')

digit :: Char -> Bool
digit :: Char -> Bool
digit Char
c = Char
'\x30' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9')
    Bool -> Bool -> Bool
||  (Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F')
    Bool -> Bool -> Bool
||  (Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> forall a. a -> a
id    ) (Char -> Parser Char
char Char
'+')
    let negative :: Parser (a -> a)
negative = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> forall a. Num a => a -> a
negate) (Char -> Parser Char
char Char
'-')
    forall {a}. Parser (a -> a)
positive forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a -> a)
negative ) 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.
    Double -> Double
sign <- forall a. Num a => Parser (a -> a)
signPrefix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id

    Integer
x <- forall (m :: * -> *). TokenParsing m => m Integer
Text.Parser.Token.decimal

    let alternative0 :: Parser Scientific
alternative0 = do
            Scientific
y <- Parser Scientific
fraction

            Scientific
e <- Parser Scientific
exponent' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
1

            forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a. Num a => Integer -> a
fromInteger Integer
x forall a. Num a => a -> a -> a
+ Scientific
y) forall a. Num a => a -> a -> a
* Scientific
e)

    let alternative1 :: Parser Scientific
alternative1 = do
            Scientific
expo <- Parser Scientific
exponent'

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => Integer -> a
fromInteger Integer
x forall a. Num a => a -> a -> a
* Scientific
expo)

    Scientific
n <- Parser Scientific
alternative0 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Scientific
alternative1

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

        String
digits <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall (m :: * -> *). CharParsing m => m Char
Text.Parser.Char.digit

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

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Scientific -> Char -> Scientific
snoc Scientific
0 String
digits)

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

        Integer -> Integer
sign <- forall a. Num a => Parser (a -> a)
signPrefix forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id

        Integer
x <- forall (m :: * -> *). TokenParsing m => m Integer
Text.Parser.Token.decimal

        forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Scientific.scientific Integer
1 (forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
sign Integer
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
_ -> forall a. Num a => a -> a
negate) (Char -> Parser Char
char Char
'-')
    Double -> Double
sign <- Parser (Double -> Double)
negative forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
    Double
a <- Text -> Parser Text
text Text
"Infinity" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1.0forall a. Fractional a => a -> a -> a
/Double
0.0)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double
sign Double
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
    Integer -> Integer
sign <- forall a. Num a => Parser (a -> a)
signPrefix
    Natural
a    <- Parser Natural
naturalLiteral
    forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer
sign (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
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
    Natural
a <-    forall (m :: * -> *) a. Parsing m => m a -> m a
try (Char -> Parser Char
char Char
'0' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
'x' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Text.Megaparsec.Char.Lexer.hexadecimal)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Natural
decimal
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'0' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Natural
0)
    forall (m :: * -> *) a. Monad m => a -> m a
return Natural
a ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
  where
    decimal :: Parser Natural
decimal = do
        Natural
n <- Parser Natural
headDigit
        [Natural]
ns <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Natural
tailDigit
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Natural] -> Natural
mkNum (Natural
nforall a. a -> [a] -> [a]
:[Natural]
ns))
      where
        headDigit :: Parser Natural
headDigit = forall {m :: * -> *} {b}.
(Monad m, CharParsing m, Num b) =>
(Char -> Bool) -> m b
decimalDigit Char -> Bool
nonZeroDigit forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"non-zero digit"
          where
            nonZeroDigit :: Char -> Bool
nonZeroDigit Char
c = Char
'1' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'

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

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

        mkNum :: [Natural] -> Natural
mkNum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' forall a. Num a => a -> a -> a
step Natural
0
          where
            step :: a -> a -> a
step a
acc a
x = a
acc forall a. Num a => a -> a -> a
* a
10 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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
4 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

    forall (m :: * -> *) a. Monad m => a -> m a
return (String
digits forall n. Num n => String -> n -> n
`base` Integer
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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    if Int
1 forall a. Ord a => a -> a -> Bool
<= Int
month Bool -> Bool -> Bool
&& Int
month forall a. Ord a => a -> a -> Bool
<= Int
12
        then forall (m :: * -> *) a. Monad m => a -> m a
return Int
month
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    if Int
1 forall a. Ord a => a -> a -> Bool
<= Int
day Bool -> Bool -> Bool
&& Int
day forall a. Ord a => a -> a -> Bool
<= Int
31
        then forall (m :: * -> *) a. Monad m => a -> m a
return Int
day
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    if Int
0 forall a. Ord a => a -> a -> Bool
<= Int
hour Bool -> Bool -> Bool
&& Int
hour forall a. Ord a => a -> a -> Bool
< Int
24
        then forall (m :: * -> *) a. Monad m => a -> m a
return Int
hour
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    if Int
0 forall a. Ord a => a -> a -> Bool
<= Int
minute Bool -> Bool -> Bool
&& Int
minute forall a. Ord a => a -> a -> Bool
< Int
60
        then forall (m :: * -> *) a. Monad m => a -> m a
return Int
minute
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
    String
digits <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
2 (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    if Pico
0 forall a. Ord a => a -> a -> Bool
<= Pico
second Bool -> Bool -> Bool
&& Pico
second forall a. Ord a => a -> a -> Bool
< Pico
60
        then forall (m :: * -> *) a. Monad m => a -> m a
return Pico
second
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
_ <- forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"."

    String
digits <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
digit)

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

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational ((String
digits forall n. Num n => String -> n -> n
`base` Integer
10) forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision)), Word
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
    Text
x <- Parser Text
label

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

    Int
n <- Parser Int
indexed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Int -> Var
V Text
x Int
n)

whitespaceChunk :: Parser ()
whitespaceChunk :: Parser ()
whitespaceChunk =
    forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile1 Char -> Bool
predicate)
        , forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\r\n" forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline")
        , forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
lineComment
        , forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
blockComment
        ] forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"whitespace"
  where
    predicate :: Char -> Bool
predicate Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c 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 = 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
        Char
c <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'0')
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'

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

    hexLower :: Parser Int
hexLower = do
        Char
c <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
10 forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'a')
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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
_ <- Text -> Parser Text
text Text
"--"

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

    Text
commentText <- (Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile Char -> Bool
predicate

    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"--" forall a. Semigroup a => a -> a -> a
<> Text
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 = forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
lineCommentPrefix 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
_ <- Text -> Parser Text
text Text
"{-"
    Text
c <- Parser Text
blockCommentContinue
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"{-" forall a. Semigroup a => a -> a -> a
<> Text
c forall a. Semigroup a => a -> a -> a
<> Text
"-}")

blockCommentChunk :: Parser Text
blockCommentChunk :: Parser Text
blockCommentChunk =
    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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'{'
            Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'
            Bool -> Bool -> Bool
||  Char
c 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'

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

    continue :: Parser Text
continue = do
        Text
c <- Parser Text
blockCommentChunk
        Text
c' <- Parser Text
blockCommentContinue
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
c forall a. Semigroup a => a -> a -> a
<> Text
c')

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

headCharacter :: Char -> Bool
headCharacter :: Char -> Bool
headCharacter Char
c = Char -> Bool
alpha Char
c Bool -> Bool -> Bool
|| Char
c 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 forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'

backtickLabel :: Parser Text
backtickLabel :: Parser Text
backtickLabel = do
    Char
_ <- Char -> Parser Char
char Char
'`'
    Text
t <- (Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile Char -> Bool
predicate
    Char
_ <- Char -> Parser Char
char Char
'`'
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
  where
    predicate :: Char -> Bool
predicate Char
c =
            Char
'\x20' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x5F'
        Bool -> Bool -> Bool
||  Char
'\x61' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Parser [a]
emptyLabels
  where
    emptyLabels :: Parser [a]
emptyLabels = do
        forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeBrace)

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

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

        Parser ()
whitespace

        [Text]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
anyLabelOrSome) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace)

        Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)

        Parser ()
_closeBrace

        forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x forall a. a -> [a] -> [a]
: [Text]
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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
False 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
    Text
t <- Parser Text
backtickLabel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
True
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
t ) 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 = forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
anyLabel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
"Some" 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 forall a. Semigroup a => a -> a -> a
<> 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 forall a. Eq a => a -> a -> Bool
== Char
'_'

    predicate1 :: Char -> Bool
predicate1 Char
c = Char -> Bool
alphaNum Char
c Bool -> Bool -> Bool
|| Char
c 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 = 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 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
_ <- Char -> Parser Char
char Char
'\\'

        Char
c <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\"\\abfnrtv" :: String))

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

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

quotedPathCharacter :: Char -> Bool
quotedPathCharacter :: Char -> Bool
quotedPathCharacter Char
c =
        (Char
'\x20' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x21')
    Bool -> Bool -> Bool
||  (Char
'\x23' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2E')
    Bool -> Bool -> Bool
||  (Char
'\x30' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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
    Text
_ <- Parser Text
"/" :: Parser Text

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

    let quotedPathData :: Parser (Tokens Text)
quotedPathData = do
            Char
_ <- Char -> Parser Char
char Char
'"'
            Tokens Text
t <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
quotedPathCharacter
            Char
_ <- Char -> Parser Char
char Char
'"'
            forall (m :: * -> *) a. Monad m => a -> m a
return Tokens Text
t

    case ComponentType
componentType of
        ComponentType
FileComponent -> Parser Text
quotedPathData 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  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")
                ComponentType
FileComponent -> forall (f :: * -> *) a. Alternative f => f a
empty

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

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

    forall (m :: * -> *) a. Monad m => a -> m a
return (File {Text
Directory
file :: Text
directory :: Directory
file :: Text
directory :: Directory
..})

scheme_ :: Parser Scheme
scheme_ :: Parser Scheme
scheme_ =
        (Parser Text
"http" :: Parser Text)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  (((Parser Text
"s" :: Parser Text) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTPS) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTP)
    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
scheme    <- Parser Scheme
scheme_
    Text
authority <- Parser Text
authority_
    File
path      <- ComponentType -> Parser File
file_ ComponentType
URLComponent
    Maybe Text
query     <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Parser Text
"?" :: Parser Text) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
query_)

    let headers :: Maybe a
headers = forall a. Maybe a
Nothing

    forall (m :: * -> *) a. Monad m => a -> m a
return (URL {Maybe Text
Text
Scheme
File
forall a. Maybe a
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
authority :: Text
scheme :: Scheme
headers :: forall a. Maybe a
query :: Maybe Text
path :: File
authority :: Text
scheme :: Scheme
..})

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

userinfo :: Parser Text
userinfo :: Parser Text
userinfo = forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate 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 forall a. Eq a => a -> a -> Bool
== Char
':'

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

port :: Parser Text
port :: Parser Text
port = 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
"[" forall a. Semigroup a => a -> a -> a
<> (Parser Text
ipV6Address forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
ipVFuture) forall a. Semigroup a => a -> a -> a
<> Parser Text
"]"

ipVFuture :: Parser Text
ipVFuture :: Parser Text
ipVFuture = Parser Text
"v" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig) forall a. Semigroup a => a -> a -> a
<> Parser Text
"." forall a. Semigroup a => a -> a -> a
<> 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 forall a. Eq a => a -> a -> Bool
== Char
':'

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

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

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

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

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

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

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

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

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

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

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

decOctet :: Parser Text
decOctet :: Parser Text
decOctet =
    forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative4
        , forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative3
        , forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative2
        , 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 forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x31' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x39'

    alternative2 :: Parser Text
alternative2 = Parser Text
"1" forall a. Semigroup a => a -> a -> a
<> 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" forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Parser Text
satisfy Char -> Bool
digit
      where
        predicate :: Char -> Bool
predicate Char
c = Char
'\x30' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x34'

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

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

domainLabel :: Parser Text
domainLabel :: Parser Text
domainLabel = forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
alphaNum_ forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star (forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus Parser Text
"-" forall a. Semigroup a => a -> a -> a
<> 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 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 forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'@'

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

pctEncoded :: Parser Text
pctEncoded :: Parser Text
pctEncoded = Parser Text
"%" forall a. Semigroup a => a -> a -> a
<> 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 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 forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c 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 = forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
t 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 = forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
c 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
x)

reservedChar :: Char -> Parser ()
reservedChar :: Char -> Parser ()
reservedChar Char
c = 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 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 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 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 = forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
x)) 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
',' 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
'@' 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'≡' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"≡\"")
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"===" 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"
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy (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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'∧' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"∧\"")
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"/\\" 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⩓' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⩓\"")
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//\\\\" 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⫽' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⫽\"")
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//" forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"//")

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

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