{-# 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 (
    validCodepoint,
    whitespace,
    lineComment,
    blockComment,
    nonemptyWhitespace,
    bashEnvironmentVariable,
    posixEnvironmentVariable,
    ComponentType(..),
    text,
    char,
    file_,
    label,
    anyLabelOrSome,
    anyLabel,
    labels,
    httpRaw,
    hexdig,
    identifier,
    hexNumber,
    doubleLiteral,
    doubleInfinity,
    naturalLiteral,
    integerLiteral,
    _Optional,
    _if,
    _then,
    _else,
    _let,
    _in,
    _as,
    _using,
    _merge,
    _toMap,
    _assert,
    _Some,
    _None,
    _NaturalFold,
    _NaturalBuild,
    _NaturalIsZero,
    _NaturalEven,
    _NaturalOdd,
    _NaturalToInteger,
    _NaturalShow,
    _NaturalSubtract,
    _IntegerClamp,
    _IntegerNegate,
    _IntegerShow,
    _IntegerToDouble,
    _DoubleShow,
    _ListBuild,
    _ListFold,
    _ListLength,
    _ListHead,
    _ListLast,
    _ListIndexed,
    _ListReverse,
    _Bool,
    _Natural,
    _Integer,
    _Double,
    _Text,
    _TextReplace,
    _TextShow,
    _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.Functor            (void, ($>))
import Data.Text               (Text)
import Dhall.Syntax
import Text.Parser.Combinators (choice, try, (<?>))

import qualified Control.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)


-- | 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 (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 (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')

signPrefix :: Num a => Parser (a -> a)
signPrefix :: Parser (a -> a)
signPrefix = (do
    let positive :: Parser (a -> a)
positive = (Char -> a -> a) -> Parser Char -> Parser (a -> a)
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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (a -> a)
negative ) Parser (a -> a) -> String -> Parser (a -> 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.
    Double -> Double
sign <- Parser (Double -> Double)
forall a. Num a => Parser (a -> a)
signPrefix Parser (Double -> Double)
-> Parser (Double -> Double) -> Parser (Double -> Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Double) -> Parser (Double -> Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double -> Double
forall a. a -> a
id

    Integer
x <- Parser Integer
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' Parser Scientific -> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
1

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

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

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

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

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

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

        let snoc :: Scientific -> Char -> Scientific
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)

        Scientific -> Parser Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return ((Scientific -> Char -> Scientific)
-> Scientific -> String -> Scientific
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
_ <- String -> Parser Char
forall (m :: * -> *). CharParsing m => String -> m Char
Text.Parser.Char.oneOf String
"eE"

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

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

        Scientific -> Parser Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Scientific.scientific Integer
1 (Integer -> Int
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 = (Char -> Double -> Double)
-> Parser Char -> Parser (Double -> Double)
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
'-')
    Double -> Double
sign <- Parser (Double -> Double)
negative Parser (Double -> Double)
-> Parser (Double -> Double) -> Parser (Double -> Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Double) -> Parser (Double -> Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double -> Double
forall a. a -> a
id
    Double
a <- Text -> Parser Text
text Text
"Infinity" Parser Text -> Parser Double -> Parser Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Parser Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0.0)
    Double -> Parser Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double
sign Double
a) ) Parser Double -> String -> Parser Double
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 <- Parser (Integer -> Integer)
forall a. Num a => Parser (a -> a)
signPrefix
    Natural
a    <- Parser Natural
naturalLiteral
    Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer
sign (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
a)) ) Parser Integer -> String -> Parser Integer
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 <-    Parser Natural -> Parser Natural
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Char -> Parser Char
char Char
'0' Parser Char -> Parser Char -> Parser Char
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 (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)
        Parser Natural -> Parser Natural -> Parser Natural
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Natural
decimal
        Parser Natural -> Parser Natural -> Parser Natural
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)
    Natural -> Parser Natural
forall (m :: * -> *) a. Monad m => a -> m a
return Natural
a ) Parser Natural -> String -> Parser Natural
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 <- Parser Natural -> Parser [Natural]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Natural
tailDigit
        Natural -> Parser Natural
forall (m :: * -> *) a. Monad m => a -> m a
return ([Natural] -> Natural
mkNum (Natural
nNatural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
:[Natural]
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 (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 (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"digit"

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

        mkNum :: [Natural] -> Natural
mkNum = (Natural -> Natural -> Natural) -> Natural -> [Natural] -> Natural
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 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 = Parser Int -> Parser Int
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
            Natural
n <- Parser Natural
naturalLiteral
            Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)

    Int
n <- Parser Int
indexed Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
    Var -> Parser Var
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Int -> Var
V Text
x Int
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 (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 (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
        Char
c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'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
        Char
c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'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
        Char
c <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy Char -> Bool
predicate
        Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'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'

-- | 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 = do
    Text
_ <- Text -> Parser Text
text Text
"--"

    let 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
'\t'

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

    Parser ()
endOfLine

    Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commentText)
  where
    endOfLine :: Parser ()
endOfLine =
        (   Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Text.Parser.Char.char Char
'\n'  )
        Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 () -> String -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline"

-- | 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
    Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"{-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-}")

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'

    endOfLine :: Parser Text
endOfLine = (Text -> Parser Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Text.Parser.Char.text Text
"\r\n" Parser Text -> String -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline")

blockCommentContinue :: Parser Text
blockCommentContinue :: Parser Text
blockCommentContinue = Parser Text
endOfComment Parser Text -> Parser Text -> Parser Text
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
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
        Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c')

simpleLabel :: Bool -> Parser Text
simpleLabel :: Bool -> Parser Text
simpleLabel Bool
allowReserved = Parser Text -> Parser Text
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
    Char
c    <- (Char -> Bool) -> Parser Char
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 (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
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
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Control.Monad.guard (Bool
isNotAKeyword Bool -> Bool -> Bool
&& (Bool
allowReserved Bool -> Bool -> Bool
|| Bool
isNotAReservedIdentifier))
    Text -> Parser Text
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 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
_ <- Char -> Parser Char
char Char
'`'
    Text
t <- (Char -> Bool) -> Parser Text
Dhall.Parser.Combinators.takeWhile Char -> Bool
predicate
    Char
_ <- Char -> Parser Char
char Char
'`'
    Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
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 (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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeBrace)

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

    nonEmptyLabels :: Parser [Text]
nonEmptyLabels = do
        Text
x  <- Parser Text -> Parser Text
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
anyLabelOrSome)

        Parser ()
whitespace

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

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

        Parser ()
_closeBrace

        [Text] -> Parser [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x Text -> [Text] -> [Text]
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 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
False Parser Text -> String -> Parser Text
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 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Text
simpleLabel Bool
True
    Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t ) Parser Text -> String -> Parser Text
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 (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
anyLabel Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text
"Some" Text -> Parser () -> Parser Text
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 (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 <- (Char -> Bool) -> Parser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\"\\abfnrtv" :: String))

        case Char
c of
            Char
'"'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\""
            Char
'\\' -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\"
            Char
'a'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\a"
            Char
'b'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\b"
            Char
'f'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\f"
            Char
'n'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
            Char
'r'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\r"
            Char
't'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\t"
            Char
'v'  -> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\v"
            Char
_    -> Parser Text
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
    Text
_ <- Parser Text
"/" :: Parser Text

    let pathData :: Parser Text
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 :: Parser Text
quotedPathData = do
            Char
_ <- Char -> Parser Char
char Char
'"'
            Text
t <- 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
quotedPathCharacter
            Char
_ <- Char -> Parser Char
char Char
'"'
            Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

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

    NonEmpty Text
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (NonEmpty Text)
emptyPath

    let directory :: Directory
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 :: Text
file      = NonEmpty Text -> Text
forall a. NonEmpty a -> a
Data.List.NonEmpty.last NonEmpty Text
path

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

scheme_ :: Parser Scheme
scheme_ :: Parser Scheme
scheme_ =
        (Parser Text
"http" :: Parser Text)
    Parser Text -> Parser Scheme -> Parser Scheme
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  (((Parser Text
"s" :: Parser Text) Parser Text -> Parser Scheme -> Parser Scheme
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scheme -> Parser Scheme
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTPS) Parser Scheme -> Parser Scheme -> Parser Scheme
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scheme -> Parser Scheme
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scheme
HTTP)
    Parser Scheme -> Parser Text -> Parser Scheme
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     <- Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Parser Text
"?" :: Parser Text) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
query_)

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

    URL -> Parser URL
forall (m :: * -> *) a. Monad m => a -> m a
return (URL :: Scheme
-> Text -> File -> Maybe Text -> Maybe (Expr Src Import) -> URL
URL {Maybe Text
Maybe (Expr Src Import)
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_ = Parser Text -> Parser Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option (Parser Text -> Parser Text
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 (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 (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 (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 (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative0
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative1
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative2
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative3
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative4
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative5
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative6
        , Parser Text -> Parser Text
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 (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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative4
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative3
        , Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Text
alternative2
        , Parser Text -> Parser Text
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 @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 @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 @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 (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 (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"@\""

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

-- | Parse the @missing@ keyword
_missing :: Parser ()
_missing :: Parser ()
_missing =
        Text -> Parser ()
keyword Text
"missing"
    Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  Parser Char -> 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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'∧' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"∧\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"/\\" Parser CharacterSet -> String -> Parser CharacterSet
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⩓' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⩓\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//\\\\" Parser CharacterSet -> String -> Parser CharacterSet
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'⫽' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"⫽\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"//" Parser CharacterSet -> String -> Parser CharacterSet
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'λ' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"λ\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Char -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'\\' Parser CharacterSet -> String -> Parser CharacterSet
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'∀' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"∀\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"forall" Parser CharacterSet -> String -> Parser CharacterSet
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'→' Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"\"→\"")
    Parser CharacterSet -> Parser CharacterSet -> Parser CharacterSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CharacterSet
ASCII CharacterSet -> Parser Text -> Parser CharacterSet
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"->" Parser CharacterSet -> String -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"->")

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