Token.hs

{-# 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 =
    (   Text.Parser.Char.text "\n"  
    <|> Text.Parser.Char.text "\r\n"
    ) <?> "newline"

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

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

    This corresponds to the @whsp@ rule in the official grammar
-}
whitespace :: Parser ()
whitespace = Text.Parser.Combinators.skipMany whitespaceChunk

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

    This corresponds to the @whsp1@ rule in the official grammar
-}
nonemptyWhitespace :: Parser ()
nonemptyWhitespace = Text.Parser.Combinators.skipSome whitespaceChunk

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

digit :: Char -> Bool
digit c = '\x30' <= c && c <= '\x39'

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

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

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

-- | Parse a leading @+@ or @-@ sign
signPrefix :: Num a => Parser (a -> a)
signPrefix = (do
    let positive = fmap (\_ -> id    ) (char '+')
    let negative = fmap (\_ -> negate) (char '-')
    positive <|> negative ) <?> "sign"

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

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

    x <- Text.Parser.Token.decimal

    let alternative0 = do
            y <- fraction

            e <- exponent' <|> pure 1

            return ((fromInteger x + y) * e)

    let alternative1 = do
            expo <- exponent'

            return (fromInteger x * expo)

    n <- alternative0 <|> alternative1

    return (sign (Scientific.toRealFloat n)) ) <?> "literal"
  where
    fraction = do
        _ <- Text.Parser.Char.char '.'

        digits <- some Text.Parser.Char.digit

        let snoc y d =
              y + Scientific.scientific (fromIntegral (Char.digitToInt d)) (Scientific.base10Exponent y - 1)

        return (List.foldl' snoc 0 digits)

    exponent' = do
        _ <- Text.Parser.Char.oneOf "eE"

        sign <- signPrefix <|> pure id

        x <- Text.Parser.Token.decimal

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

{-| Parse a signed @Infinity@

    This corresponds to the @minus-infinity-literal@ and @plus-infinity-literal@
    rules from the official grammar
-}
doubleInfinity :: Parser Double
doubleInfinity = (do
    let negative = fmap (\_ -> negate) (char '-')
    sign <- negative <|> pure id
    a <- text "Infinity" >> return (1.0/0.0)
    return (sign a) ) <?> "literal"

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

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

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

    This corresponds to the @natural-literal@ rule from the official grammar
-}
naturalLiteral :: Parser Natural
naturalLiteral = (do
    a <-    binary
        <|> hexadecimal
        <|> decimal
        <|> (char '0' $> 0)
    return a ) <?> "literal"
  where
    binary = try (char '0' >> char 'b' >> Text.Megaparsec.Char.Lexer.binary)
    hexadecimal = try (char '0' >> char 'x' >> Text.Megaparsec.Char.Lexer.hexadecimal)
    decimal = do
        n <- headDigit
        ns <- many tailDigit
        return (mkNum (n:ns))
      where
        headDigit = decimalDigit nonZeroDigit <?> "non-zero digit"
          where
            nonZeroDigit c = '1' <= c && c <= '9'

        tailDigit = decimalDigit digit <?> "digit"

        decimalDigit predicate = do
            c <- Text.Parser.Char.satisfy predicate
            return (fromIntegral (Char.ord c - Char.ord '0'))

        mkNum = Data.Foldable.foldl' step 0
          where
            step acc x = acc * 10 + x

{-| Parse a 4-digit year

    This corresponds to the @date-fullyear@ rule from the official grammar
-}
dateFullYear :: Parser Integer
dateFullYear = do
    digits <- Monad.replicateM 4 (Text.Parser.Char.satisfy digit)

    return (digits `base` 10)

{-| Parse a 2-digit month

    This corresponds to the @date-month@ rule from the official grammar
-}
dateMonth :: Parser Int
dateMonth = do
    digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit)

    let month = digits `base` 10

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

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

    This corresponds to the @date-mday@ rule from the official grammar
-}
dateMday :: Parser Int
dateMday = do
    digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit)

    let day = digits `base` 10

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

{-| Parse a 2-digit hour

    This corresponds to the @time-hour@ rule from the official grammar
-}
timeHour :: Parser Int
timeHour = do
    digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit)

    let hour = digits `base` 10

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

{-| Parse a 2-digit minute

    This corresponds to the @time-minute@ rule from the official grammar
-}
timeMinute :: Parser Int
timeMinute = do
    digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit)

    let minute = digits `base` 10

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

{-| Parse a 2-digit second

    This corresponds to the @time-second@ rule from the official grammar
-}
timeSecond :: Parser Pico
timeSecond = do
    digits <- Monad.replicateM 2 (Text.Parser.Char.satisfy digit)

    let second = digits `base` 10

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

{-| Parse the fractional component of a second

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

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

    let precision = fromIntegral (length digits)

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

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

    Variables can have an optional index to disambiguate shadowed variables

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

    let indexed = try $ do
            whitespace
            _at
            whitespace
            n <- naturalLiteral
            return (fromIntegral n)

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

whitespaceChunk :: Parser ()
whitespaceChunk =
    choice
        [ void (Dhall.Parser.Combinators.takeWhile1 predicate)
        , void (Text.Parser.Char.text "\r\n" <?> "newline")
        , void lineComment
        , void blockComment
        ] <?> "whitespace"
  where
    predicate c = c == ' ' || c == '\t' || c == '\n'

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

    hexUpper = do
        c <- Text.Parser.Char.satisfy predicate
        return (10 + Char.ord c - Char.ord 'A')
      where
        predicate c = 'A' <= c && c <= 'F'

    hexLower = do
        c <- Text.Parser.Char.satisfy predicate
        return (10 + Char.ord c - Char.ord 'a')
      where
        predicate c = 'a' <= c && c <= 'f'

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

    let predicate c = ('\x20' <= c && c <= '\x10FFFF') || c == '\t'

    commentText <- Dhall.Parser.Combinators.takeWhile predicate

    return ("--" <> commentText)

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

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

blockCommentChunk :: Parser Text
blockCommentChunk =
    choice
        [ blockComment  -- Nested block comment
        , characters
        , character
        , endOfLine
        ]
  where
    characters = (Dhall.Parser.Combinators.takeWhile1 predicate)
      where
        predicate c =
                '\x20' <= c && c <= '\x10FFFF' && c /= '-' && c /= '{'
            ||  c == '\n'
            ||  c == '\t'

    character = (Dhall.Parser.Combinators.satisfy predicate)
      where
        predicate c = '\x20' <= c && c <= '\x10FFFF' || c == '\n' || c == '\t'

blockCommentContinue :: Parser Text
blockCommentContinue = endOfComment <|> continue
  where
    endOfComment = void (text "-}") *> pure ""

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

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

headCharacter :: Char -> Bool
headCharacter c = alpha c || c == '_'

tailCharacter :: Char -> Bool
tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/'

backtickLabel :: Parser Text
backtickLabel = do
    _ <- char '`'
    t <- Dhall.Parser.Combinators.takeWhile predicate
    _ <- char '`'
    return t
  where
    predicate c =
            '\x20' <= c && c <= '\x5F'
        ||  '\x61' <= c && c <= '\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 = do
    _openBrace

    whitespace

    nonEmptyLabels <|> emptyLabels
  where
    emptyLabels = do
        try (optional (_comma *> whitespace) *> _closeBrace)

        pure []

    nonEmptyLabels = do
        x  <- try (optional (_comma *> whitespace) *> anyLabelOrSome)

        whitespace

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

        _ <- optional (_comma *> whitespace)

        _closeBrace

        return (x : xs)

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

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

    This corresponds to the @nonreserved-label@ rule in the official grammar
-}
label :: Parser Text
label = backtickLabel <|> simpleLabel False <?> "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 = (do
    t <- backtickLabel <|> simpleLabel True
    return t ) <?> "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 = try anyLabel <|> ("Some" <$ _Some)

{-| Parse a valid Bash environment variable name

    This corresponds to the @bash-environment-variable@ rule in the official
    grammar
-}
bashEnvironmentVariable :: Parser Text
bashEnvironmentVariable = satisfy predicate0 <> star (satisfy predicate1)
  where
    predicate0 c = alpha c || c == '_'

    predicate1 c = alphaNum c || c == '_'

{-| 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 = plus posixEnvironmentVariableCharacter

posixEnvironmentVariableCharacter :: Parser Text
posixEnvironmentVariableCharacter =
    escapeCharacter <|> satisfy predicate1
  where
    escapeCharacter = do
        _ <- char '\\'

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

        case c of
            '"'  -> return "\""
            '\\' -> return "\\"
            'a'  -> return "\a"
            'b'  -> return "\b"
            'f'  -> return "\f"
            'n'  -> return "\n"
            'r'  -> return "\r"
            't'  -> return "\t"
            'v'  -> return "\v"
            _    -> empty

    predicate1 c =
            ('\x20' <= c && c <= '\x21')
        ||  ('\x23' <= c && c <= '\x3C')
        ||  ('\x3E' <= c && c <= '\x5B')
        ||  ('\x5D' <= c && c <= '\x7E')

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

    let pathData =
            case componentType of
                FileComponent ->
                    Text.Megaparsec.takeWhile1P Nothing Dhall.Syntax.pathCharacter
                URLComponent ->
                    star pchar

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

    case componentType of
        FileComponent -> quotedPathData <|> pathData
        URLComponent -> pathData

-- | Parse a `File`
file_ :: ComponentType -> Parser File
file_ componentType = do
    let emptyPath =
            case componentType of
                URLComponent  -> pure (pure "")
                FileComponent -> empty

    path <- Data.List.NonEmpty.some1 (pathComponent componentType) <|> emptyPath

    let directory = Directory (reverse (Data.List.NonEmpty.init path))
    let file      = Data.List.NonEmpty.last path

    return (File {..})

scheme_ :: Parser Scheme
scheme_ =
        ("http" :: Parser Text)
    *>  ((("s" :: Parser Text) *> pure HTTPS) <|> pure HTTP)
    <*  ("://" :: 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 = do
    scheme    <- scheme_
    authority <- authority_
    path      <- file_ URLComponent
    query     <- optional (("?" :: Parser Text) *> query_)

    let headers = Nothing

    return (URL {..})

authority_ :: Parser Text
authority_ = option (try (userinfo <> "@")) <> host <> option (":" <> port)

userinfo :: Parser Text
userinfo = star (satisfy predicate <|> pctEncoded)
  where
    predicate c = unreserved c || subDelims c || c == ':'

host :: Parser Text
host = choice [ ipLiteral, try ipV4Address, domain ]

port :: Parser Text
port = star (satisfy digit)

ipLiteral :: Parser Text
ipLiteral = "[" <> (ipV6Address <|> ipVFuture) <> "]"

ipVFuture :: Parser Text
ipVFuture = "v" <> plus (satisfy hexdig) <> "." <> plus (satisfy predicate)
  where
    predicate c = unreserved c || subDelims c || c == ':'

ipV6Address :: Parser Text
ipV6Address =
    choice
        [ try alternative0
        , try alternative1
        , try alternative2
        , try alternative3
        , try alternative4
        , try alternative5
        , try alternative6
        , try alternative7
        ,     alternative8
        ]
  where
    alternative0 = count 6 (h16 <> ":") <> ls32

    alternative1 = "::" <> count 5 (h16 <> ":") <> ls32

    alternative2 = option h16 <> "::" <> count 4 (h16 <> ":") <> ls32

    alternative3 =
            option (h16 <> range 0 1 (try (":" <> h16)))
        <>  "::"
        <>  count 3 (h16 <> ":")
        <>  ls32

    alternative4 =
            option (h16 <> range 0 2 (try (":" <> h16)))
        <>  "::"
        <>  count 2 (h16 <> ":")
        <>  ls32

    alternative5 =
            option (h16 <> range 0 3 (try (":" <> h16)))
        <>  "::"
        <>  h16
        <>  ":"
        <>  ls32

    alternative6 =
        option (h16 <> range 0 4 (try (":" <> h16))) <> "::" <> ls32

    alternative7 =
        option (h16 <> range 0 5 (try (":" <> h16))) <> "::" <> h16

    alternative8 =
        option (h16 <> range 0 6 (try (":" <> h16))) <> "::"

h16 :: Parser Text
h16 = range 1 3 (satisfy hexdig)

ls32 :: Parser Text
ls32 = try (h16 <> ":" <> h16) <|> ipV4Address

ipV4Address :: Parser Text
ipV4Address = decOctet <> "." <> decOctet <> "." <> decOctet <> "." <> decOctet

decOctet :: Parser Text
decOctet =
    choice
        [ try alternative4
        , try alternative3
        , try alternative2
        , try alternative1
        ,     alternative0
        ]
  where
    alternative0 = satisfy digit

    alternative1 = satisfy predicate <> satisfy digit
      where
        predicate c = '\x31' <= c && c <= '\x39'

    alternative2 = "1" <> count 2 (satisfy digit)

    alternative3 = "2" <> satisfy predicate <> satisfy digit
      where
        predicate c = '\x30' <= c && c <= '\x34'

    alternative4 = "25" <> satisfy predicate
      where
        predicate c = '\x30' <= c && c <= '\x35'

domain :: Parser Text
domain = domainLabel <> star ("." <> domainLabel ) <> option "."

domainLabel :: Parser Text
domainLabel = plus alphaNum_ <> star (plus "-" <> plus alphaNum_)
  where
    alphaNum_ = satisfy alphaNum

pchar :: Parser Text
pchar = satisfy predicate <|> pctEncoded
  where
    predicate c = unreserved c || subDelims c || c == ':' || c == '@'

query_ :: Parser Text
query_ = star (pchar <|> satisfy predicate)
  where
    predicate c = c == '/' || c == '?'

pctEncoded :: Parser Text
pctEncoded = "%" <> count 2 (satisfy hexdig)

subDelims :: Char -> Bool
subDelims c = c `elem` ("!$&'*+;=" :: String)

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

{-| A variation on `Text.Parser.Char.text` that doesn't quote the expected
    in error messages
-}
text :: Data.Text.Text -> Parser Text
text t = Text.Parser.Char.text t <?> Data.Text.unpack 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 c = Text.Parser.Char.char c <?> [ c ]
{-# INLINE char #-}

reserved :: Data.Text.Text -> Parser ()
reserved x = void (text x)

reservedChar :: Char -> Parser ()
reservedChar c = void (char c)

builtin :: Data.Text.Text -> Parser ()
builtin x = reserved x <?> "built-in"
{-# INLINE builtin #-}

operator :: Data.Text.Text -> Parser ()
operator x = reserved x <?> "operator"
{-# INLINE operator #-}

operatorChar :: Char -> Parser ()
operatorChar x = reservedChar x <?> "operator"
{-# INLINE operatorChar #-}

keyword :: Data.Text.Text -> Parser ()
keyword x = try (void (text x)) <?> "keyword"

{-| Parse the @if@ keyword

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

{-| Parse the @then@ keyword

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

{-| Parse the @else@ keyword

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

{-| Parse the @let@ keyword

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

{-| Parse the @in@ keyword

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

{-| Parse the @as@ keyword

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

{-| Parse the @using@ keyword

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

{-| Parse the @merge@ keyword

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

{-| Parse the @toMap@ keyword

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

{-| Parse the @showConstructor@ keyword

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

{-| Parse the @assert@ keyword

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

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

{-| Parse the @Some@ built-in

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

{-| Parse the @None@ built-in

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-| Parse the @Bool@ built-in

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

{-| Parse the @Bytes@ built-in

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

{-| Parse the @Optional@ built-in

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

{-| Parse the @Natural@ built-in

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

{-| Parse the @Integer@ built-in

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

{-| Parse the @Double@ built-in

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

{-| Parse the @Text@ built-in

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

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

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

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

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

{-| Parse the @Date@ bult-in

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

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

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

{-| Parse the @Time@ bult-in

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

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

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

{-| Parse the @TimeZone@ bult-in

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

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

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

{-| Parse the @List@ built-in

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

{-| Parse the @True@ built-in

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

{-| Parse the @False@ built-in

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

{-| Parse a @NaN@ literal

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

{-| Parse the @Type@ built-in

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

{-| Parse the @Kind@ built-in

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

{-| Parse the @Sort@ built-in

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

{-| Parse the @Location@ keyword

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Parse the @,@ symbol
_comma :: Parser ()
_comma = reservedChar ',' <?> "\',\'"

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

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

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

-- | Parse the @\@@ symbol
_at :: Parser ()
_at = reservedChar '@' <?> "\"@\""

-- | Parse the equivalence symbol (@===@ or @≡@)
_equivalent :: Parser CharacterSet
_equivalent =
        (Unicode <$ char '≡' <?> "\"≡\"")
    <|> (ASCII <$ text "===" <?> "===")

-- | Parse the @missing@ keyword
_missing :: Parser ()
_missing =
        keyword "missing"
    *>  Text.Megaparsec.notFollowedBy (Text.Parser.Char.satisfy tailCharacter)

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

-- | Parse the record combine operator (@/\\@ or @∧@)
_combine :: Parser CharacterSet
_combine =
        (Unicode <$ char '∧' <?> "\"∧\"")
    <|> (ASCII <$ text "/\\" <?> "/\\")

-- | Parse the record type combine operator (@//\\\\@ or @⩓@)
_combineTypes :: Parser CharacterSet
_combineTypes =
        (Unicode <$ char '⩓' <?> "\"⩓\"")
    <|> (ASCII <$ text "//\\\\" <?> "//\\\\")

-- | Parse the record \"prefer\" operator (@//@ or @⫽@)
_prefer :: Parser CharacterSet
_prefer =
        (Unicode <$ char '⫽' <?> "\"⫽\"")
    <|> (ASCII <$ text "//" <?> "//")

-- | Parse a lambda (@\\@ or @λ@)
_lambda :: Parser CharacterSet
_lambda =
        (Unicode <$ char 'λ' <?> "\"λ\"")
    <|> (ASCII <$ char '\\' <?> "\\")

-- | Parse a forall (@forall@ or @∀@)
_forall :: Parser CharacterSet
_forall =
        (Unicode <$ char '∀' <?> "\"∀\"")
    <|> (ASCII <$ text "forall" <?> "forall")

-- | Parse a right arrow (@->@ or @→@)
_arrow :: Parser CharacterSet
_arrow =
        (Unicode <$ char '→' <?> "\"→\"")
    <|> (ASCII <$ text "->" <?> "->")

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