{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedLists     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Parsing Dhall expressions.
module Dhall.Parser.Expression where

import Control.Applicative     (Alternative (..), liftA2, optional)
import Data.Foldable           (foldl')
import Data.List.NonEmpty      (NonEmpty (..))
import Data.Text               (Text)
import Dhall.Src               (Src (..))
import Dhall.Syntax
import Text.Parser.Combinators (choice, try, (<?>))

import qualified Control.Monad
import qualified Control.Monad.Combinators          as Combinators
import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty
import qualified Data.ByteString                    as ByteString
import qualified Data.ByteString.Base16             as Base16
import qualified Data.Char                          as Char
import qualified Data.List
import qualified Data.List.NonEmpty                 as NonEmpty
import qualified Data.Sequence
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Data.Time                          as Time
import qualified Dhall.Crypto
import qualified Text.Megaparsec

import Dhall.Parser.Combinators
import Dhall.Parser.Token

-- | Get the current source offset (in tokens)
getOffset :: Text.Megaparsec.MonadParsec e s m => m Int
getOffset :: forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset = forall s e. State s e -> Int
Text.Megaparsec.stateOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
Text.Megaparsec.getParserState
{-# INLINE getOffset #-}

-- | Set the current source offset
setOffset :: Text.Megaparsec.MonadParsec e s m => Int -> m ()
setOffset :: forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
Text.Megaparsec.updateParserState forall a b. (a -> b) -> a -> b
$ \State s e
state ->
    State s e
state
        { stateOffset :: Int
Text.Megaparsec.stateOffset = Int
o }
{-# INLINE setOffset #-}

{-| Wrap a `Parser` to still match the same text but return only the `Src`
    span
-}
src :: Parser a -> Parser Src
src :: forall a. Parser a -> Parser Src
src Parser a
parser = do
    SourcePos
before      <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, a
_) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
    SourcePos
after       <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens)

-- | Same as `src`, except also return the parsed value
srcAnd :: Parser a -> Parser (Src, a)
srcAnd :: forall a. Parser a -> Parser (Src, a)
srcAnd Parser a
parser = do
    SourcePos
before      <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, a
x) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
    SourcePos
after       <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens, a
x)

{-| Wrap a `Parser` to still match the same text, but to wrap the resulting
    `Expr` in a `Note` constructor containing the `Src` span
-}
noted :: Parser (Expr Src a) -> Parser (Expr Src a)
noted :: forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
parser = do
    SourcePos
before      <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, Expr Src a
e) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser (Expr Src a)
parser
    SourcePos
after       <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    let src₀ :: Src
src₀ = SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens
    case Expr Src a
e of
        Note Src
src₁ Expr Src a
_ | Src -> Src -> Bool
laxSrcEq Src
src₀ Src
src₁ -> forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
e
        Expr Src a
_                                -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. s -> Expr s a -> Expr s a
Note Src
src₀ Expr Src a
e)

{-| Parse a complete expression (with leading and trailing whitespace)

    This corresponds to the @complete-expression@ rule from the official
    grammar
-}
completeExpression :: Parser a -> Parser (Expr Src a)
completeExpression :: forall a. Parser a -> Parser (Expr Src a)
completeExpression Parser a
embedded = Parser (Expr Src a)
completeExpression_
  where
    Parsers {Parser (Expr Src a)
Parser (Binding Src a)
letBinding :: forall a. Parsers a -> Parser (Binding Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
letBinding :: Parser (Binding Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..} = forall a. Parser a -> Parsers a
parsers Parser a
embedded

{-| Parse an \"import expression\"

    This is not the same thing as @`fmap` `Embed`@.  This parses any
    expression of the same or higher precedence as an import expression (such
    as a selector expression).  For example, this parses @(1)@

    This corresponds to the @import-expression@ rule from the official grammar
-}
importExpression :: Parser a -> Parser (Expr Src a)
importExpression :: forall a. Parser a -> Parser (Expr Src a)
importExpression Parser a
embedded = Parser (Expr Src a)
importExpression_
  where
    Parsers {Parser (Expr Src a)
Parser (Binding Src a)
letBinding :: Parser (Binding Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
letBinding :: forall a. Parsers a -> Parser (Binding Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
..} = forall a. Parser a -> Parsers a
parsers Parser a
embedded

{-| For efficiency (and simplicity) we only expose two parsers from the
    result of the `parsers` function, since these are the only parsers needed
    outside of this module
-}
data Parsers a = Parsers
    { forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
    , forall a. Parsers a -> Parser (Expr Src a)
importExpression_   :: Parser (Expr Src a)
    , forall a. Parsers a -> Parser (Binding Src a)
letBinding          :: Parser (Binding Src a)
    }

{-| Parse a numeric `TimeZone`

    This corresponds to the @time-numoffset@ rule from the official grammar
-}
timeNumOffset :: Parser (Expr s a)
timeNumOffset :: forall s a. Parser (Expr s a)
timeNumOffset = do
    Int -> Int
s <- forall a. Num a => Parser (a -> a)
signPrefix

    Int
hour <- Parser Int
timeHour

    Text
_ <- Text -> Parser Text
text Text
":"

    Int
minute <- Parser Int
timeMinute

    let minutes :: Int
minutes = Int -> Int
s (Int
hour forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
minute)

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. TimeZone -> Expr s a
TimeZoneLiteral (Int -> Bool -> String -> TimeZone
Time.TimeZone Int
minutes Bool
Prelude.False String
""))

{-| Parse a numeric `TimeZone` or a @Z@

    This corresponds to the @time-offset@ rule from the official grammar
-}
timeOffset :: Parser (Expr s a)
timeOffset :: forall s a. Parser (Expr s a)
timeOffset =
        (do Text
_ <- Text -> Parser Text
text Text
"Z"

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. TimeZone -> Expr s a
TimeZoneLiteral (Int -> Bool -> String -> TimeZone
Time.TimeZone Int
0 Bool
Prelude.False String
""))
        )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s a. Parser (Expr s a)
timeNumOffset

{-| Parse a `Time`

    This corresponds to the @partial-time@ rule from the official grammar
-}
partialTime :: Parser (Expr s a)
partialTime :: forall s a. Parser (Expr s a)
partialTime = do
    Int
hour <- Parser Int
timeHour

    Text
_ <- Text -> Parser Text
text Text
":"

    Int
minute <- Parser Int
timeMinute

    Text
_ <- Text -> Parser Text
text Text
":"

    Pico
second <- Parser Pico
timeSecond

    (Pico
fraction, Word
precision) <- Parser (Pico, Word)
timeSecFrac forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico
0, Word
0)

    let time :: TimeOfDay
time = Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Int
hour Int
minute (Pico
second forall a. Num a => a -> a -> a
+ Pico
fraction)

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
time Word
precision)

{-| Parse a `Date`

    This corresponds to the @full-date@ rule from the official grammar
-}
fullDate :: Parser (Expr s a)
fullDate :: forall s a. Parser (Expr s a)
fullDate = do
    Integer
year <- Parser Integer
dateFullYear

    Text
_ <- Text -> Parser Text
text Text
"-"

    Int
month <- Parser Int
dateMonth

    Text
_ <- Text -> Parser Text
text Text
"-"

    Int
day <- Parser Int
dateMday

    case Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid Integer
year Int
month Int
day of
        Maybe Day
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid calendar day"
        Just Day
d  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Day -> Expr s a
DateLiteral Day
d)

{-| Parse a `Date`, `Time`, `TimeZone` or any valid permutation of them as a
    record

    This corresponds to the @temporal-literal@ rule from the official grammar
-}
temporalLiteral :: Parser (Expr s a)
temporalLiteral :: forall s a. Parser (Expr s a)
temporalLiteral =
        forall (m :: * -> *) a. Parsing m => m a -> m a
try (do
            Expr s a
date <- forall s a. Parser (Expr s a)
fullDate

            Text
_ <- Text -> Parser Text
text Text
"T" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
text Text
"t"

            Expr s a
time <- forall s a. Parser (Expr s a)
partialTime

            Expr s a
timeZone <- forall s a. Parser (Expr s a)
timeOffset

            forall (m :: * -> *) a. Monad m => a -> m a
return
                (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit
                    [   (Text
"date"    , forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
date)
                    ,   (Text
"time"    , forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
time)
                    ,   (Text
"timeZone", forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
timeZone)
                    ]
                )
        )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try (do
            Expr s a
date <- forall s a. Parser (Expr s a)
fullDate

            Text
_ <- Text -> Parser Text
text Text
"T" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
text Text
"t"

            Expr s a
time <- forall s a. Parser (Expr s a)
partialTime

            forall (m :: * -> *) a. Monad m => a -> m a
return
                (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit
                    [   (Text
"date", forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
date)
                    ,   (Text
"time", forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
time)
                    ]
                )
        )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try (do
            Expr s a
time <- forall s a. Parser (Expr s a)
partialTime

            Expr s a
timeZone <- forall s a. Parser (Expr s a)
timeOffset

            forall (m :: * -> *) a. Monad m => a -> m a
return
                (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit
                    [   (Text
"time"    , forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
time)
                    ,   (Text
"timeZone", forall s a. Expr s a -> RecordField s a
makeRecordField Expr s a
timeZone)
                    ]
                )
        )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try forall s a. Parser (Expr s a)
fullDate
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try forall s a. Parser (Expr s a)
partialTime
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Parsing m => m a -> m a
try forall s a. Parser (Expr s a)
timeNumOffset

-- | Parse a \"shebang\" line (i.e. an initial line beginning with @#!@)
shebang :: Parser ()
shebang :: Parser ()
shebang = do
    Text
_ <- Text -> Parser Text
text Text
"#!"

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

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

    Text
_ <- Parser Text
endOfLine

    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Given a parser for imports,
parsers :: forall a. Parser a -> Parsers a
parsers :: forall a. Parser a -> Parsers a
parsers Parser a
embedded = Parsers{Parser (Expr Src a)
Parser (Binding Src a)
importExpression_ :: Parser (Expr Src a)
letBinding :: Parser (Binding Src a)
completeExpression_ :: Parser (Expr Src a)
letBinding :: Parser (Binding Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..}
  where
    completeExpression_ :: Parser (Expr Src a)
completeExpression_ =
            Parser ()
whitespace
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  Parser (Expr Src a)
expression
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ()
whitespace
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
lineCommentPrefix

    letBinding :: Parser (Binding Src a)
letBinding = do
        Src
src0 <- forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_let forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace)

        Text
c <- Parser Text
label

        Src
src1 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

        Maybe (Maybe Src, Expr Src a)
d <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
            Parser ()
_colon

            Src
src2 <- forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace

            Expr Src a
e <- Parser (Expr Src a)
expression

            Parser ()
whitespace

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Src
src2, Expr Src a
e) )

        Parser ()
_equal

        Src
src3 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

        Expr Src a
f <- Parser (Expr Src a)
expression

        Parser ()
whitespace

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding (forall a. a -> Maybe a
Just Src
src0) Text
c (forall a. a -> Maybe a
Just Src
src1) Maybe (Maybe Src, Expr Src a)
d (forall a. a -> Maybe a
Just Src
src3) Expr Src a
f)

    expression :: Parser (Expr Src a)
expression =
        forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted
            ( forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Parser (Expr Src a)
alternative0
                , Parser (Expr Src a)
alternative1
                , Parser (Expr Src a)
alternative2
                , Parser (Expr Src a)
alternative3
                , Parser (Expr Src a)
alternative4
                , Parser (Expr Src a)
alternative5
                ]
            ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"expression"
      where
        alternative0 :: Parser (Expr Src a)
alternative0 = do
            CharacterSet
cs <- Parser CharacterSet
_lambda
            Parser ()
whitespace
            Parser ()
_openParens
            Src
src0 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
            Text
a <- Parser Text
label
            Src
src1 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
            Parser ()
_colon
            Src
src2 <- forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace
            Expr Src a
b <- Parser (Expr Src a)
expression
            Parser ()
whitespace
            Parser ()
_closeParens
            Parser ()
whitespace
            CharacterSet
cs' <- Parser CharacterSet
_arrow
            Parser ()
whitespace
            Expr Src a
c <- Parser (Expr Src a)
expression
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam (forall a. a -> Maybe a
Just (CharacterSet
cs forall a. Semigroup a => a -> a -> a
<> CharacterSet
cs')) (forall s a.
Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
FunctionBinding (forall a. a -> Maybe a
Just Src
src0) Text
a (forall a. a -> Maybe a
Just Src
src1) (forall a. a -> Maybe a
Just Src
src2) Expr Src a
b) Expr Src a
c)

        alternative1 :: Parser (Expr Src a)
alternative1 = do
            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_if forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
            Expr Src a
a <- Parser (Expr Src a)
expression
            Parser ()
whitespace
            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_then forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
            Expr Src a
b <- Parser (Expr Src a)
expression
            Parser ()
whitespace
            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_else forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
            Expr Src a
c <- Parser (Expr Src a)
expression
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf Expr Src a
a Expr Src a
b Expr Src a
c)

        alternative2 :: Parser (Expr Src a)
alternative2 = do
            NonEmpty (Binding Src a)
as <- forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NonEmpty.some1 Parser (Binding Src a)
letBinding

            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_in forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

            Expr Src a
b <- Parser (Expr Src a)
expression

            -- 'Note's in let-in-let:
            --
            -- Subsequent @let@s that are not separated by an @in@ only get a
            -- single surrounding 'Note'. For example:
            --
            -- let x = a
            -- let y = b
            -- in  let z = c
            --     in x
            --
            -- is parsed as
            --
            -- (Note …
            --   (Let x …
            --     (Let y …
            --       (Note …
            --         (Let z …
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) s a.
Foldable f =>
f (Binding s a) -> Expr s a -> Expr s a
Dhall.Syntax.wrapInLets NonEmpty (Binding Src a)
as Expr Src a
b)

        alternative3 :: Parser (Expr Src a)
alternative3 = do
            CharacterSet
cs <- forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser CharacterSet
_forall forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
_openParens)
            Parser ()
whitespace
            Text
a <- Parser Text
label
            Parser ()
whitespace
            Parser ()
_colon
            Parser ()
nonemptyWhitespace
            Expr Src a
b <- Parser (Expr Src a)
expression
            Parser ()
whitespace
            Parser ()
_closeParens
            Parser ()
whitespace
            CharacterSet
cs' <- Parser CharacterSet
_arrow
            Parser ()
whitespace
            Expr Src a
c <- Parser (Expr Src a)
expression
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi (forall a. a -> Maybe a
Just (CharacterSet
cs forall a. Semigroup a => a -> a -> a
<> CharacterSet
cs')) Text
a Expr Src a
b Expr Src a
c)

        alternative4 :: Parser (Expr Src a)
alternative4 = do
            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_assert forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_colon)
            Parser ()
nonemptyWhitespace
            Expr Src a
a <- Parser (Expr Src a)
expression
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a
Assert Expr Src a
a)

        alternative5 :: Parser (Expr Src a)
alternative5 = do
            (ApplicationExprInfo
a0Info, Expr Src a
a0) <- Parser (ApplicationExprInfo, Expr Src a)
applicationExpressionWithInfo

            let (Parser (Expr Src a)
parseFirstOperatorExpression, Parser (Expr Src a)
parseOperatorExpression) =
                    Parser (Expr Src a) -> (Parser (Expr Src a), Parser (Expr Src a))
operatorExpression (forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a0)

            let alternative5A :: Parser (Expr Src a)
alternative5A = do
                    case ApplicationExprInfo
a0Info of
                        ApplicationExprInfo
ImportExpr -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        ApplicationExprInfo
_          -> forall (f :: * -> *) a. Alternative f => f a
empty

                    [Expr Src a -> Expr Src a]
bs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (do
                        forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
nonemptyWhitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_with forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

                        let withComponent :: Parser WithComponent
withComponent =
                                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> WithComponent
WithLabel Parser Text
anyLabelOrSome
                                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
_ -> WithComponent
WithQuestion) (Text -> Parser Text
text Text
"?")

                        NonEmpty WithComponent
keys <- forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
Combinators.NonEmpty.sepBy1 Parser WithComponent
withComponent (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)

                        Parser ()
whitespace

                        Parser ()
_equal

                        Parser ()
whitespace

                        Expr Src a
value <- Parser (Expr Src a)
parseOperatorExpression

                        forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr Src a
e -> forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With Expr Src a
e NonEmpty WithComponent
keys Expr Src a
value) )

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expr Src a
e Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
e) Expr Src a
a0 [Expr Src a -> Expr Src a]
bs)

            let alternative5B :: Parser (Expr Src a)
alternative5B = do
                    Expr Src a
a <- Parser (Expr Src a)
parseFirstOperatorExpression

                    Parser ()
whitespace

                    let alternative5B0 :: Parser (Expr Src a)
alternative5B0 = do
                            CharacterSet
cs <- Parser CharacterSet
_arrow
                            Parser ()
whitespace
                            Expr Src a
b <- Parser (Expr Src a)
expression
                            Parser ()
whitespace
                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi (forall a. a -> Maybe a
Just CharacterSet
cs) Text
"_" Expr Src a
a Expr Src a
b)

                    let alternative5B1 :: Parser (Expr Src a)
alternative5B1 = do
                            Parser ()
_colon
                            Parser ()
nonemptyWhitespace
                            case (forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
a, ApplicationExprInfo
a0Info) of
                                (ListLit Maybe (Expr Src a)
Nothing [], ApplicationExprInfo
_) -> do
                                    Expr Src a
b <- Parser (Expr Src a)
expression

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (forall a. a -> Maybe a
Just Expr Src a
b) [])
                                (Merge Expr Src a
c Expr Src a
d Maybe (Expr Src a)
Nothing, ApplicationExprInfo
NakedMergeOrSomeOrToMap) -> do
                                    Expr Src a
b <- Parser (Expr Src a)
expression

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr Src a
c Expr Src a
d (forall a. a -> Maybe a
Just Expr Src a
b))
                                (ToMap Expr Src a
c Maybe (Expr Src a)
Nothing, ApplicationExprInfo
NakedMergeOrSomeOrToMap) -> do
                                    Expr Src a
b <- Parser (Expr Src a)
expression

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr Src a
c (forall a. a -> Maybe a
Just Expr Src a
b))
                                (Expr Src a, ApplicationExprInfo)
_ -> do
                                    Expr Src a
b <- Parser (Expr Src a)
expression

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src a
a Expr Src a
b)

                    let alternative5B2 :: Parser (Expr Src a)
alternative5B2 =
                            case forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
a of
                                ListLit Maybe (Expr Src a)
Nothing [] ->
                                    forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list literal without annotation"
                                Expr Src a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a

                    Parser (Expr Src a)
alternative5B0 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative5B1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative5B2

            Parser (Expr Src a)
alternative5A forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative5B

    -- The firstApplicationExpression argument is necessary in order to
    -- left-factor the parsers for function types and @with@ expressions to
    -- minimize backtracking
    --
    -- For a longer explanation, see:
    --
    -- https://github.com/dhall-lang/dhall-haskell/pull/1770#discussion_r419022486
    operatorExpression :: Parser (Expr Src a) -> (Parser (Expr Src a), Parser (Expr Src a))
operatorExpression Parser (Expr Src a)
firstApplicationExpression =
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a))
cons (Parser (Expr Src a), Parser (Expr Src a))
nil forall s. [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers
      where
        cons :: Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a))
cons Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser (Parser (Expr Src a)
p0, Parser (Expr Src a)
p) =
            ( forall {a} {a}.
Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
p0 Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
p
            , forall {a} {a}.
Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
p  Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
p
            )

        nil :: (Parser (Expr Src a), Parser (Expr Src a))
nil = (Parser (Expr Src a)
firstApplicationExpression, Parser (Expr Src a)
applicationExpression)

    makeOperatorExpression :: Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
firstSubExpression Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
subExpression = do
            Expr Src a
a <- Parser (Expr Src a)
firstSubExpression

            [Expr Src a -> Expr Src a]
bs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many forall a b. (a -> b) -> a -> b
$ do
                (Src SourcePos
_ SourcePos
_ Text
textOp, Expr Src a -> Expr Src a -> Expr Src a
op0) <- forall a. Parser a -> Parser (Src, a)
srcAnd (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser))

                Expr Src a
r0 <- Parser (Expr Src a)
subExpression

                let l :: Expr Src a
l@(Note (Src SourcePos
startL SourcePos
_ Text
textL) Expr Src a
_) op :: Expr Src a -> Expr Src a -> Expr Src a
`op` r :: Expr Src a
r@(Note (Src SourcePos
_ SourcePos
endR Text
textR) Expr Src a
_) =
                        forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
startL SourcePos
endR (Text
textL forall a. Semigroup a => a -> a -> a
<> Text
textOp forall a. Semigroup a => a -> a -> a
<> Text
textR)) (Expr Src a
l Expr Src a -> Expr Src a -> Expr Src a
`op0` Expr Src a
r)
                    -- We shouldn't hit this branch if things are working, but
                    -- that is not enforced in the types
                    Expr Src a
l `op` Expr Src a
r =
                        Expr Src a
l Expr Src a -> Expr Src a -> Expr Src a
`op0` Expr Src a
r

                forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
`op` Expr Src a
r0)

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Expr Src a
x Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
x) Expr Src a
a [Expr Src a -> Expr Src a]
bs)

    operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
    operatorParsers :: forall s. [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers =
        [ forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CharacterSet
_equivalent   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt                   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_importAlt     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr                      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_or            forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus                 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_plus          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend                  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_textAppend    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend                  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_listAppend    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd                     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_and           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , (\CharacterSet
cs -> forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine (forall a. a -> Maybe a
Just CharacterSet
cs) forall a. Maybe a
Nothing)         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CharacterSet
_combine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , (\CharacterSet
cs -> forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer (forall a. a -> Maybe a
Just CharacterSet
cs) PreferAnnotation
PreferFromSource) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CharacterSet
_prefer  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CharacterSet
_combineTypes forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes                forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_times         forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        -- Make sure that `==` is not actually the prefix of `===`
        , forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ                      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_doubleEqual forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy (Char -> Parser Char
char Char
'=')) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE                      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_notEqual      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        ]

    applicationExpression :: Parser (Expr Src a)
applicationExpression = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ApplicationExprInfo, Expr Src a)
applicationExpressionWithInfo

    applicationExpressionWithInfo :: Parser (ApplicationExprInfo, Expr Src a)
    applicationExpressionWithInfo :: Parser (ApplicationExprInfo, Expr Src a)
applicationExpressionWithInfo = do
            let alternative0 :: Parser (Expr Src a -> Expr Src a, Maybe String)
alternative0 = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_merge forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

                    Expr Src a
a <- Parser (Expr Src a)
importExpression_ forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace

                    forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr Src a
b -> forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr Src a
a Expr Src a
b forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just String
"second argument to ❰merge❱")

            let alternative1 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative1 = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_Some forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a
Some, forall a. a -> Maybe a
Just String
"argument to ❰Some❱")

            let alternative2 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative2 = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_toMap forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr s a
a -> forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr s a
a forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just String
"argument to ❰toMap❱")

            let alternative3 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative3 = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_showConstructor forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr s a
a -> forall s a. Expr s a -> Expr s a
ShowConstructor Expr s a
a, forall a. a -> Maybe a
Just String
"argument to ❰showConstructor❱")

            let alternative4 :: Parser (a -> a, Maybe a)
alternative4 =
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a
id, forall a. Maybe a
Nothing)

            (Expr Src a -> Expr Src a
f, Maybe String
maybeMessage) <- Parser (Expr Src a -> Expr Src a, Maybe String)
alternative0 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {s} {a}. Parser (Expr s a -> Expr s a, Maybe String)
alternative1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {s} {a}. Parser (Expr s a -> Expr s a, Maybe String)
alternative2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {s} {a}. Parser (Expr s a -> Expr s a, Maybe String)
alternative3 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. Parser (a -> a, Maybe a)
alternative4

            let adapt :: m a -> m a
adapt m a
parser =
                    case Maybe String
maybeMessage of
                        Maybe String
Nothing      -> m a
parser
                        Just String
message -> m a
parser forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
message

            Expr Src a
a <- forall {m :: * -> *} {a}. Parsing m => m a -> m a
adapt (forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
importExpression_)

            [(Text, Expr Src a)]
bs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Parsing m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
                (Text
sep, ()
_) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser ()
nonemptyWhitespace
                Expr Src a
b <- Parser (Expr Src a)
importExpression_
                forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sep, Expr Src a
b)

            let c :: Expr Src a
c = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Expr Src a -> (Text, Expr Src a) -> Expr Src a
app (Expr Src a -> Expr Src a
f Expr Src a
a) [(Text, Expr Src a)]
bs

            let info :: ApplicationExprInfo
info =
                    case (Maybe String
maybeMessage, [(Text, Expr Src a)]
bs) of
                        (Just String
_ , []) -> ApplicationExprInfo
NakedMergeOrSomeOrToMap
                        (Maybe String
Nothing, []) -> ApplicationExprInfo
ImportExpr
                        (Maybe String, [(Text, Expr Src a)])
_             -> ApplicationExprInfo
ApplicationExpr

            forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationExprInfo
info, Expr Src a
c)
          where
            app :: Expr Src a -> (Text, Expr Src a) -> Expr Src a
app Expr Src a
a (Text
sep, Expr Src a
b)
                | Note (Src SourcePos
left SourcePos
_ Text
bytesL) Expr Src a
_ <- Expr Src a
a
                , Note (Src SourcePos
_ SourcePos
right Text
bytesR) Expr Src a
_ <- Expr Src a
b
                = forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
left SourcePos
right (Text
bytesL forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> Text
bytesR)) (forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src a
a Expr Src a
b)
            app Expr Src a
a (Text
_, Expr Src a
b) =
                forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src a
a Expr Src a
b

    importExpression_ :: Parser (Expr Src a)
importExpression_ = forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted (forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ forall {s}. Parser (Expr s a)
alternative0, Parser (Expr Src a)
alternative1 ])
          where
            alternative0 :: Parser (Expr s a)
alternative0 = do
                a
a <- Parser a
embedded
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. a -> Expr s a
Embed a
a)

            alternative1 :: Parser (Expr Src a)
alternative1 = Parser (Expr Src a)
completionExpression

    completionExpression :: Parser (Expr Src a)
completionExpression = forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted (do
        Expr Src a
a <- Parser (Expr Src a)
selectorExpression

        Maybe (Expr Src a)
mb <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
            forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_doubleColon)

            Parser ()
whitespace

            Parser (Expr Src a)
selectorExpression )

        case Maybe (Expr Src a)
mb of
            Maybe (Expr Src a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a
            Just Expr Src a
b  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Expr s a
RecordCompletion Expr Src a
a Expr Src a
b) )

    selectorExpression :: Parser (Expr Src a)
selectorExpression = forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted (do
            Expr Src a
a <- Parser (Expr Src a)
primitiveExpression

            let recordType :: Parser (Expr Src a)
recordType = Parser ()
_openParens forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
_closeParens

            let field :: FieldSelection s -> Expr s a -> Expr s a
field               FieldSelection s
x  Expr s a
e = forall s a. Expr s a -> FieldSelection s -> Expr s a
Field   Expr s a
e  FieldSelection s
x
            let projectBySet :: [Text] -> Expr s a -> Expr s a
projectBySet        [Text]
xs Expr s a
e = forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
e (forall a b. a -> Either a b
Left  [Text]
xs)
            let projectByExpression :: Expr s a -> Expr s a -> Expr s a
projectByExpression Expr s a
xs Expr s a
e = forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
e (forall a b. b -> Either a b
Right Expr s a
xs)

            let alternatives :: Parser (Expr Src a -> Expr Src a)
alternatives = do
                    Src
src0 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

                    let fieldSelection :: Parser (FieldSelection Src)
fieldSelection = do
                            Text
l <- Parser Text
anyLabel

                            SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos

                            -- FIXME: Suffix whitespace can't be parsed given our limitation
                            -- about whitespace treatment, but for @dhall-docs@ this
                            -- is enough
                            let src1 :: Src
src1 = SourcePos -> SourcePos -> Text -> Src
Src SourcePos
pos SourcePos
pos Text
""

                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection (forall a. a -> Maybe a
Just Src
src0) Text
l (forall a. a -> Maybe a
Just Src
src1))

                    let result :: Parser (Expr Src a -> Expr Src a)
result =
                                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {s} {a}. FieldSelection s -> Expr s a -> Expr s a
field               Parser (FieldSelection Src)
fieldSelection
                            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {s} {a}. [Text] -> Expr s a -> Expr s a
projectBySet        Parser [Text]
labels
                            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a -> Expr s a
projectByExpression Parser (Expr Src a)
recordType

                    Parser (Expr Src a -> Expr Src a)
result

            [Expr Src a -> Expr Src a]
b <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a -> Expr Src a)
alternatives))

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Expr Src a
e Expr Src a -> Expr Src a
k -> Expr Src a -> Expr Src a
k Expr Src a
e) Expr Src a
a [Expr Src a -> Expr Src a]
b) )

    primitiveExpression :: Parser (Expr Src a)
primitiveExpression =
            forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted
                ( forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                    [ forall s a. Parser (Expr s a)
bytesLiteral
                    , forall s a. Parser (Expr s a)
temporalLiteral
                    , forall s a. Parser (Expr s a)
alternative00
                    , forall s a. Parser (Expr s a)
alternative01
                    , forall s a. Parser (Expr s a)
alternative02
                    , Parser (Expr Src a)
textLiteral
                    , Parser (Expr Src a)
alternative04
                    , Parser (Expr Src a)
unionType
                    , Parser (Expr Src a)
listLiteral
                    , forall s a. Parser (Expr s a)
alternative37
                    , forall s a. Parser (Expr s a)
alternative09
                    , forall s a. Parser (Expr s a)
builtin
                    ]
                )
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative38
          where
            alternative00 :: Parser (Expr s a)
alternative00 = do
                Int
n <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
                Double
a <- forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Double
doubleLiteral
                Double
b <- if forall a. RealFloat a => a -> Bool
isInfinite Double
a
                       then forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
n forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"double out of bounds"
                       else forall (m :: * -> *) a. Monad m => a -> m a
return Double
a
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
b))

            alternative01 :: Parser (Expr s a)
alternative01 = do
                Natural
a <- forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Natural
naturalLiteral
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Natural -> Expr s a
NaturalLit Natural
a)

            alternative02 :: Parser (Expr s a)
alternative02 = do
                Integer
a <- forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Integer
integerLiteral
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit Integer
a)

            alternative04 :: Parser (Expr Src a)
alternative04 = (do
                Parser ()
_openBrace

                Src
src0 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
                Maybe ()
mComma <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
_comma

                -- `src1` corresponds to the prefix whitespace of the first key-value
                -- pair. This is done to avoid using `try` to recover the consumed
                -- whitespace when the comma is not consumed
                Src
src1 <- case Maybe ()
mComma of
                    Maybe ()
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Src
src0
                    Just ()
_ -> forall a. Parser a -> Parser Src
src Parser ()
whitespace

                Expr Src a
a <- Src -> Parser (Expr Src a)
recordTypeOrLiteral Src
src1

                Parser ()
_closeBrace

                forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

            alternative09 :: Parser (Expr s a)
alternative09 = do
                Double
a <- forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Double
doubleInfinity
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
a))

            builtin :: Parser (Expr s a)
builtin = do
                let predicate :: Char -> Bool
predicate Char
c =
                            Char
c forall a. Eq a => a -> a -> Bool
== Char
'N'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'I'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'D'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'L'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'O'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'B'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'S'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'T'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'F'
                        Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'K'

                let nan :: DhallDouble
nan = Double -> DhallDouble
DhallDouble (Double
0.0forall a. Fractional a => a -> a -> a
/Double
0.0)

                Char
c <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.lookAhead (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
predicate)

                case Char
c of
                    Char
'N' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
NaturalFold      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalFold
                            , forall s a. Expr s a
NaturalBuild     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalBuild
                            , forall s a. Expr s a
NaturalIsZero    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalIsZero
                            , forall s a. Expr s a
NaturalEven      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalEven
                            , forall s a. Expr s a
NaturalOdd       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalOdd
                            , forall s a. Expr s a
NaturalSubtract  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalSubtract
                            , forall s a. Expr s a
NaturalToInteger forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalToInteger
                            , forall s a. Expr s a
NaturalShow      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalShow
                            , forall s a. Expr s a
Natural          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Natural
                            , forall s a. Expr s a
None             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_None
                            , forall s a. DhallDouble -> Expr s a
DoubleLit DhallDouble
nan    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaN
                            ]
                    Char
'I' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
IntegerClamp     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerClamp
                            , forall s a. Expr s a
IntegerNegate    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerNegate
                            , forall s a. Expr s a
IntegerShow      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerShow
                            , forall s a. Expr s a
IntegerToDouble  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerToDouble
                            , forall s a. Expr s a
Integer          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Integer
                            ]

                    Char
'D' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
DateShow         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_DateShow
                            , forall s a. Expr s a
Date             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Date
                            , forall s a. Expr s a
DoubleShow       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_DoubleShow
                            , forall s a. Expr s a
Double           forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Double
                            ]
                    Char
'L' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
ListBuild        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListBuild
                            , forall s a. Expr s a
ListFold         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListFold
                            , forall s a. Expr s a
ListLength       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListLength
                            , forall s a. Expr s a
ListHead         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListHead
                            , forall s a. Expr s a
ListLast         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListLast
                            , forall s a. Expr s a
ListIndexed      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListIndexed
                            , forall s a. Expr s a
ListReverse      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListReverse
                            , forall s a. Expr s a
List             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_List
                            ]
                    Char
'O' ->    forall s a. Expr s a
Optional         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Optional
                    Char
'B' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
Bool             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Bool
                            , forall s a. Expr s a
Bytes            forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Bytes
                            ]
                    Char
'S' ->    forall s a. Const -> Expr s a
Const Const
Sort       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Sort
                    Char
'T' ->
                        forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                            [ forall s a. Expr s a
TextReplace      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TextReplace
                            , forall s a. Expr s a
TextShow         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TextShow
                            , forall s a. Expr s a
Text             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Text
                            , forall s a. Expr s a
TimeZoneShow     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeZoneShow
                            , forall s a. Expr s a
TimeZone         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeZone
                            , forall s a. Expr s a
TimeShow         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeShow
                            , forall s a. Expr s a
Time             forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Time
                            , forall s a. Bool -> Expr s a
BoolLit Bool
True     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_True
                            , forall s a. Const -> Expr s a
Const Const
Type       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Type
                            ]
                    Char
'F' ->    forall s a. Bool -> Expr s a
BoolLit Bool
False    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_False
                    Char
'K' ->    forall s a. Const -> Expr s a
Const Const
Kind       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Kind
                    Char
_   ->    forall (f :: * -> *) a. Alternative f => f a
empty

            alternative37 :: Parser (Expr s a)
alternative37 = do
                Var
a <- Parser Var
identifier
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Var -> Expr s a
Var Var
a)

            alternative38 :: Parser (Expr Src a)
alternative38 = do
                Parser ()
_openParens
                Parser ()
whitespace
                Expr Src a
a <- Parser (Expr Src a)
expression
                Parser ()
whitespace
                Parser ()
_closeParens
                forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a

    doubleQuotedChunk :: Parser (Chunks Src a)
doubleQuotedChunk =
            forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Parser (Chunks Src a)
interpolation
                , forall {s} {a}. Parser (Chunks s a)
unescapedCharacterFast
                , forall {s} {a}. Parser (Chunks s a)
unescapedCharacterSlow
                , forall {s} {a}. Parser (Chunks s a)
escapedCharacter
                ]
          where
            interpolation :: Parser (Chunks Src a)
interpolation = do
                Text
_ <- Text -> Parser Text
text Text
"${"
                Expr Src a
e <- Parser (Expr Src a)
completeExpression_
                Char
_ <- Char -> Parser Char
char Char
'}'
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(forall a. Monoid a => a
mempty, Expr Src a
e)] forall a. Monoid a => a
mempty)

            unescapedCharacterFast :: Parser (Chunks s a)
unescapedCharacterFast = do
                Text
t <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
predicate
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
t)
              where
                predicate :: Char -> Bool
predicate Char
c =
                    (   (Char
'\x20' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x21'    )
                    Bool -> Bool -> Bool
||  (Char
'\x23' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x5B'    )
                    Bool -> Bool -> Bool
||  (Char
'\x5D' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF')
                    ) Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'$'

            unescapedCharacterSlow :: Parser (Chunks s a)
unescapedCharacterSlow = do
                Char
_ <- Char -> Parser Char
char Char
'$'
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"$")

            escapedCharacter :: Parser (Chunks s a)
escapedCharacter = do
                Char
_ <- Char -> Parser Char
char Char
'\\'
                Char
c <- forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                    [ Parser Char
quotationMark
                    , Parser Char
dollarSign
                    , Parser Char
backSlash
                    , Parser Char
forwardSlash
                    , Parser Char
backSpace
                    , Parser Char
formFeed
                    , Parser Char
lineFeed
                    , Parser Char
carriageReturn
                    , Parser Char
tab
                    , Parser Char
unicode
                    ]
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (Char -> Text
Data.Text.singleton Char
c))
              where
                quotationMark :: Parser Char
quotationMark = Char -> Parser Char
char Char
'"'

                dollarSign :: Parser Char
dollarSign = Char -> Parser Char
char Char
'$'

                backSlash :: Parser Char
backSlash = Char -> Parser Char
char Char
'\\'

                forwardSlash :: Parser Char
forwardSlash = Char -> Parser Char
char Char
'/'

                backSpace :: Parser Char
backSpace = do Char
_ <- Char -> Parser Char
char Char
'b'; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'

                formFeed :: Parser Char
formFeed = do Char
_ <- Char -> Parser Char
char Char
'f'; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'

                lineFeed :: Parser Char
lineFeed = do Char
_ <- Char -> Parser Char
char Char
'n'; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'

                carriageReturn :: Parser Char
carriageReturn = do Char
_ <- Char -> Parser Char
char Char
'r'; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'

                tab :: Parser Char
tab = do Char
_ <- Char -> Parser Char
char Char
't'; forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'

                unicode :: Parser Char
unicode = do
                    Char
_  <- Char -> Parser Char
char Char
'u';

                    let toNumber :: [Int] -> Int
toNumber = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\Int
x Int
y -> Int
x forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Int
y) Int
0

                    let fourCharacterEscapeSequence :: Parser Int
fourCharacterEscapeSequence = do
                            [Int]
ns <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM Int
4 Parser Int
hexNumber

                            let number :: Int
number = [Int] -> Int
toNumber [Int]
ns

                            forall (f :: * -> *). Alternative f => Bool -> f ()
Control.Monad.guard (Int -> Bool
validCodepoint Int
number)
                                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Unicode code point"

                            forall (m :: * -> *) a. Monad m => a -> m a
return Int
number

                    let bracedEscapeSequence :: Parser Int
bracedEscapeSequence = do
                            Char
_  <- Char -> Parser Char
char Char
'{'
                            [Int]
ns <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Int
hexNumber

                            let number :: Int
number = [Int] -> Int
toNumber [Int]
ns

                            forall (f :: * -> *). Alternative f => Bool -> f ()
Control.Monad.guard (Int
number forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFD Bool -> Bool -> Bool
&& Int -> Bool
validCodepoint Int
number)
                                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Unicode code point"

                            Char
_  <- Char -> Parser Char
char Char
'}'

                            forall (m :: * -> *) a. Monad m => a -> m a
return Int
number

                    Int
n <- Parser Int
bracedEscapeSequence forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int
fourCharacterEscapeSequence

                    forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
Char.chr Int
n)

    doubleQuotedLiteral :: Parser (Chunks Src a)
doubleQuotedLiteral = do
            Char
_      <- Char -> Parser Char
char Char
'"'
            [Chunks Src a]
chunks <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many Parser (Chunks Src a)
doubleQuotedChunk
            Char
_      <- Char -> Parser Char
char Char
'"'
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => [a] -> a
mconcat [Chunks Src a]
chunks)

    singleQuoteContinue :: Parser (Chunks Src a)
singleQuoteContinue =
            forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Parser (Chunks Src a)
escapeSingleQuotes
                , Parser (Chunks Src a)
interpolation
                , Parser (Chunks Src a)
escapeInterpolation
                , Parser (Chunks Src a)
endLiteral
                , Parser (Chunks Src a)
unescapedCharacterFast
                , Parser (Chunks Src a)
unescapedCharacterSlow
                , Parser (Chunks Src a)
tab
                , Parser (Chunks Src a)
endOfLine_
                ]
          where
                escapeSingleQuotes :: Parser (Chunks Src a)
escapeSingleQuotes = do
                    Text
_ <- Parser Text
"'''" :: Parser Text
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"''" forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)

                interpolation :: Parser (Chunks Src a)
interpolation = do
                    Text
_ <- Text -> Parser Text
text Text
"${"
                    Expr Src a
a <- Parser (Expr Src a)
completeExpression_
                    Char
_ <- Char -> Parser Char
char Char
'}'
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(forall a. Monoid a => a
mempty, Expr Src a
a)] forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)

                escapeInterpolation :: Parser (Chunks Src a)
escapeInterpolation = do
                    Text
_ <- Text -> Parser Text
text Text
"''${"
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"${" forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)

                endLiteral :: Parser (Chunks Src a)
endLiteral = do
                    Text
_ <- Text -> Parser Text
text Text
"''"
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

                unescapedCharacterFast :: Parser (Chunks Src a)
unescapedCharacterFast = do
                    Text
a <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
predicate
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
                  where
                    predicate :: Char -> Bool
predicate Char
c =
                        (Char
'\x20' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF') Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\''

                unescapedCharacterSlow :: Parser (Chunks Src a)
unescapedCharacterSlow = do
                    Text
a <- (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
                  where
                    predicate :: Char -> Bool
predicate Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''

                endOfLine_ :: Parser (Chunks Src a)
endOfLine_ = do
                    Text
a <- Parser Text
"\n" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
"\r\n"
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)

                tab :: Parser (Chunks Src a)
tab = do
                    Char
_ <- Char -> Parser Char
char Char
'\t' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"tab"
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"\t" forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)

    singleQuoteLiteral :: Parser (Chunks Src a)
singleQuoteLiteral = do
            Text
_ <- Text -> Parser Text
text Text
"''"

            Text
_ <- Parser Text
endOfLine

            Chunks Src a
a <- Parser (Chunks Src a)
singleQuoteContinue

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Chunks Src a -> Chunks Src a
Dhall.Syntax.toDoubleQuoted Chunks Src a
a)

    textLiteral :: Parser (Expr Src a)
textLiteral = (do
        Chunks Src a
literal <- Parser (Chunks Src a)
doubleQuotedLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Chunks Src a)
singleQuoteLiteral
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Chunks s a -> Expr s a
TextLit Chunks Src a
literal) ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

    bytesLiteral :: Parser (Expr s a)
bytesLiteral = (do
        Text
_ <- Text -> Parser Text
text Text
"0x\""

        let byte :: Parser Word8
byte = do
                Token Text
nibble0 <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
hexdig
                Token Text
nibble1 <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
hexdig
                forall (m :: * -> *) a. Monad m => a -> m a
return ([Token Text
nibble0, Token Text
nibble1] forall n. Num n => String -> n -> n
`base` Word8
16)

        [Word8]
bytes <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many Parser Word8
byte

        Char
_ <- Char -> Parser Char
char Char
'"'

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. ByteString -> Expr s a
BytesLit ([Word8] -> ByteString
ByteString.pack [Word8]
bytes)) ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

    recordTypeOrLiteral :: Src -> Parser (Expr Src a)
recordTypeOrLiteral Src
firstSrc0 =
            forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ forall s a. Parser (Expr s a)
emptyRecordLiteral
                , Src -> Parser (Expr Src a)
nonEmptyRecordTypeOrLiteral Src
firstSrc0
                , forall s a. Parser (Expr s a)
emptyRecordType
                ]

    emptyRecordLiteral :: Parser (Expr s a)
emptyRecordLiteral = do
        Parser ()
_equal

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

        Parser ()
whitespace
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a. Monoid a => a
mempty)

    emptyRecordType :: Parser (Expr s a)
emptyRecordType = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a. Monoid a => a
mempty)

    nonEmptyRecordTypeOrLiteral :: Src -> Parser (Expr Src a)
nonEmptyRecordTypeOrLiteral Src
firstSrc0 = do
            let nonEmptyRecordType :: Parser (Expr Src a)
nonEmptyRecordType = do
                    (Src
firstKeySrc1, Text
a) <- forall (m :: * -> *) a. Parsing m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
                        Text
a <- Parser Text
anyLabelOrSome
                        Src
s <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
                        Parser ()
_colon
                        forall (m :: * -> *) a. Monad m => a -> m a
return (Src
s, Text
a)

                    Src
firstKeySrc2 <- forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace

                    Expr Src a
b <- Parser (Expr Src a)
expression

                    [(Text, RecordField Src a)]
e <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many forall a b. (a -> b) -> a -> b
$ do
                        (Src
src0', Text
c) <- forall (m :: * -> *) a. Parsing m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
                            Parser ()
_comma
                            Src
src0' <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
                            Text
c <- Parser Text
anyLabelOrSome
                            forall (m :: * -> *) a. Monad m => a -> m a
return (Src
src0', Text
c)

                        Src
src1 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

                        Parser ()
_colon

                        Src
src2 <- forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace

                        Expr Src a
d <- Parser (Expr Src a)
expression

                        Parser ()
whitespace

                        forall (m :: * -> *) a. Monad m => a -> m a
return (Text
c, forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (forall a. a -> Maybe a
Just Src
src0') Expr Src a
d (forall a. a -> Maybe a
Just Src
src1) (forall a. a -> Maybe a
Just Src
src2))

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

                    Map Text (RecordField Src a)
m <- forall a. [(Text, a)] -> Parser (Map Text a)
toMap ((Text
a, forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (forall a. a -> Maybe a
Just Src
firstSrc0) Expr Src a
b (forall a. a -> Maybe a
Just Src
firstKeySrc1) (forall a. a -> Maybe a
Just Src
firstKeySrc2)) forall a. a -> [a] -> [a]
: [(Text, RecordField Src a)]
e)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
Record Map Text (RecordField Src a)
m)

            let keysValue :: Maybe Src -> Parser (Text, RecordField Src a)
keysValue Maybe Src
maybeSrc = do
                    Src
firstSrc0' <- case Maybe Src
maybeSrc of
                        Just Src
src0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Src
src0
                        Maybe Src
Nothing -> forall a. Parser a -> Parser Src
src Parser ()
whitespace
                    Text
firstLabel <- Parser Text
anyLabelOrSome
                    Src
firstSrc1 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

                    let parseLabelWithWhsp :: Parser (Src, Text, Src)
parseLabelWithWhsp = forall (m :: * -> *) a. Parsing m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
                            Parser ()
_dot
                            Src
src0 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
                            Text
l <- Parser Text
anyLabelOrSome
                            Src
src1 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace
                            forall (m :: * -> *) a. Monad m => a -> m a
return (Src
src0, Text
l, Src
src1)

                    [(Src, Text, Src)]
restKeys <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Combinators.many Parser (Src, Text, Src)
parseLabelWithWhsp
                    let keys :: NonEmpty (Src, Text, Src)
keys = (Src
firstSrc0', Text
firstLabel, Src
firstSrc1) forall a. a -> [a] -> NonEmpty a
:| [(Src, Text, Src)]
restKeys

                    let normalRecordEntry :: Parser (Text, RecordField Src a)
normalRecordEntry = do
                            forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser ()
_equal

                            Src
lastSrc2 <- forall a. Parser a -> Parser Src
src Parser ()
whitespace

                            Expr Src a
value <- Parser (Expr Src a)
expression

                            let cons :: (s, a, s) -> (Text, RecordField s a) -> (a, RecordField s a)
cons (s
s0, a
key, s
s1) (Text
key', RecordField s a
values) =
                                    (a
key, forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (forall a. a -> Maybe a
Just s
s0) (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit [ (Text
key', RecordField s a
values) ]) (forall a. a -> Maybe a
Just s
s1) forall a. Maybe a
Nothing)

                            let (Src
lastSrc0, Text
lastLabel, Src
lastSrc1) = forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (Src, Text, Src)
keys
                            let nil :: (Text, RecordField Src a)
nil = (Text
lastLabel, forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (forall a. a -> Maybe a
Just Src
lastSrc0) Expr Src a
value (forall a. a -> Maybe a
Just Src
lastSrc1) (forall a. a -> Maybe a
Just Src
lastSrc2))

                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {s} {a} {a}.
(s, a, s) -> (Text, RecordField s a) -> (a, RecordField s a)
cons (Text, RecordField Src a)
nil (forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty (Src, Text, Src)
keys))

                    let punnedEntry :: Parser (Text, RecordField Src a)
punnedEntry =
                            case NonEmpty (Src, Text, Src)
keys of
                                (Src
s0, Text
x, Src
s1) :| [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (forall a. a -> Maybe a
Just Src
s0) (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
0)) (forall a. a -> Maybe a
Just Src
s1) forall a. Maybe a
Nothing)
                                NonEmpty (Src, Text, Src)
_       -> forall (f :: * -> *) a. Alternative f => f a
empty

                    (Parser (Text, RecordField Src a)
normalRecordEntry forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Parser (Text, RecordField Src a)
punnedEntry) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace

            let nonEmptyRecordLiteral :: Parser (Expr Src a)
nonEmptyRecordLiteral = do
                    (Text, RecordField Src a)
a <- Maybe Src -> Parser (Text, RecordField Src a)
keysValue (forall a. a -> Maybe a
Just Src
firstSrc0)

                    [(Text, RecordField Src a)]
as <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Src -> Parser (Text, RecordField Src a)
keysValue forall a. Maybe a
Nothing))

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

                    Parser ()
whitespace

                    let combine :: Text
-> f (RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
combine Text
k = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b. (a -> b) -> a -> b
$ \RecordField s a
rf RecordField s a
rf' -> forall s a. Expr s a -> RecordField s a
makeRecordField forall a b. (a -> b) -> a -> b
$ forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine forall a. Monoid a => a
mempty (forall a. a -> Maybe a
Just Text
k)
                                                            (forall s a. RecordField s a -> Expr s a
recordFieldValue RecordField s a
rf')
                                                            (forall s a. RecordField s a -> Expr s a
recordFieldValue RecordField s a
rf)

                    Map Text (RecordField Src a)
m <- forall a.
(Text -> Parser a -> Parser a -> Parser a)
-> [(Text, a)] -> Parser (Map Text a)
toMapWith forall {f :: * -> *} {s} {a}.
Applicative f =>
Text
-> f (RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
combine ((Text, RecordField Src a)
a forall a. a -> [a] -> [a]
: [(Text, RecordField Src a)]
as)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField Src a)
m)

            Parser (Expr Src a)
nonEmptyRecordType forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
nonEmptyRecordLiteral

    unionType :: Parser (Expr Src a)
unionType = (do
            Parser ()
_openAngle

            Parser ()
whitespace

            let unionTypeEntry :: Parser (Text, Maybe (Expr Src a))
unionTypeEntry = do
                    Text
a <- Parser Text
anyLabelOrSome

                    Parser ()
whitespace

                    Maybe (Expr Src a)
b <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_colon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
a, Maybe (Expr Src a)
b)

            let nonEmptyUnionType :: Parser (Expr Src a)
nonEmptyUnionType = do
                    (Text, Maybe (Expr Src a))
kv <- forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_bar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Maybe (Expr Src a))
unionTypeEntry)

                    [(Text, Maybe (Expr Src a))]
kvs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_bar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Maybe (Expr Src a))
unionTypeEntry))

                    Map Text (Maybe (Expr Src a))
m <- forall a. [(Text, a)] -> Parser (Map Text a)
toMap ((Text, Maybe (Expr Src a))
kv forall a. a -> [a] -> [a]
: [(Text, Maybe (Expr Src a))]
kvs)

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

                    Parser ()
_closeAngle

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src a))
m)

            let emptyUnionType :: Parser (Expr s a)
emptyUnionType = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_bar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeAngle)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union forall a. Monoid a => a
mempty)

            Parser (Expr Src a)
nonEmptyUnionType forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s a. Parser (Expr s a)
emptyUnionType ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

    listLiteral :: Parser (Expr Src a)
listLiteral = (do
            Parser ()
_openBracket

            Parser ()
whitespace

            let nonEmptyListLiteral :: Parser (Expr Src a)
nonEmptyListLiteral = do
                    Expr Src a
a <- forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression)

                    Parser ()
whitespace

                    [Expr Src a]
as <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace)

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

                    Parser ()
_closeBracket

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit forall a. Maybe a
Nothing (forall a. [a] -> Seq a
Data.Sequence.fromList (Expr Src a
a forall a. a -> [a] -> [a]
: [Expr Src a]
as)))

            let emptyListLiteral :: Parser (Expr s a)
emptyListLiteral = do
                    forall (m :: * -> *) a. Parsing m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeBracket)

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit forall a. Maybe a
Nothing forall a. Monoid a => a
mempty)

            Parser (Expr Src a)
nonEmptyListLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s a. Parser (Expr s a)
emptyListLiteral) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"

{-| Parse an environment variable import

    This corresponds to the @env@ rule from the official grammar
-}
env :: Parser ImportType
env :: Parser ImportType
env = do
    Text
_ <- Text -> Parser Text
text Text
"env:"
    Text
a <- (Parser Text
alternative0 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
alternative1)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ImportType
Env Text
a)
  where
    alternative0 :: Parser Text
alternative0 = Parser Text
bashEnvironmentVariable

    alternative1 :: Parser Text
alternative1 = do
        Char
_ <- Char -> Parser Char
char Char
'"'
        Text
a <- Parser Text
posixEnvironmentVariable
        Char
_ <- Char -> Parser Char
char Char
'"'
        forall (m :: * -> *) a. Monad m => a -> m a
return Text
a

-- | Parse a local import without trailing whitespace
localOnly :: Parser ImportType
localOnly :: Parser ImportType
localOnly =
    forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Parser ImportType
parentPath
        , Parser ImportType
herePath
        , Parser ImportType
homePath
        , forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser ImportType
absolutePath
        ]
  where
    parentPath :: Parser ImportType
parentPath = do
        Text
_    <- Parser Text
".." :: Parser Text
        File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent

        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Parent File
file)

    herePath :: Parser ImportType
herePath = do
        Text
_    <- Parser Text
"." :: Parser Text
        File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent

        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Here File
file)

    homePath :: Parser ImportType
homePath = do
        Text
_    <- Parser Text
"~" :: Parser Text
        File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent

        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Home File
file)

    absolutePath :: Parser ImportType
absolutePath = do
        File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent

        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Absolute File
file)

{-| Parse a local import

    This corresponds to the @local@ rule from the official grammar
-}
local :: Parser ImportType
local :: Parser ImportType
local = do
    ImportType
a <- Parser ImportType
localOnly
    forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
a

{-| Parse an HTTP(S) import

    This corresponds to the @http@ rule from the official grammar
-}
http :: Parser ImportType
http :: Parser ImportType
http = do
    URL
url <- Parser URL
httpRaw
    Maybe (Expr Src Import)
headers <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
        forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_using forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
        forall a. Parser a -> Parser (Expr Src a)
importExpression Parser Import
import_ )
    forall (m :: * -> *) a. Monad m => a -> m a
return (URL -> ImportType
Remote (URL
url { Maybe (Expr Src Import)
headers :: Maybe (Expr Src Import)
headers :: Maybe (Expr Src Import)
headers }))

{-| Parse a `Missing` import

    This corresponds to the @missing@ rule from the official grammar
-}
missing :: Parser ImportType
missing :: Parser ImportType
missing = do
  Parser ()
_missing
  forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
Missing

{-| Parse an `ImportType`

    This corresponds to the @import-type@ rule from the official grammar
-}
importType_ :: Parser ImportType
importType_ :: Parser ImportType
importType_ = do
    let predicate :: Char -> Bool
predicate Char
c =
            Char
c forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'h' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'm'

    Token Text
_ <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.lookAhead (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
predicate)

    forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Parser ImportType
local, Parser ImportType
http, Parser ImportType
env, Parser ImportType
missing ]

{-| Parse a `Dhall.Crypto.SHA256Digest`

    This corresponds to the @hash@ rule from the official grammar
-}
importHash_ :: Parser Dhall.Crypto.SHA256Digest
importHash_ :: Parser SHA256Digest
importHash_ = do
    Text
_ <- Text -> Parser Text
text Text
"sha256:"
    Text
t <- forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
64 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"hex digit")
    let strictBytes16 :: ByteString
strictBytes16 = Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
t
    ByteString
strictBytes <- case ByteString -> Either String ByteString
Base16.decode ByteString
strictBytes16 of
        Left  String
string      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
string
        Right ByteString
strictBytes -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
strictBytes
    case ByteString -> Maybe SHA256Digest
Dhall.Crypto.sha256DigestFromByteString ByteString
strictBytes of
      Maybe SHA256Digest
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid sha256 hash"
      Just SHA256Digest
h  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SHA256Digest
h

{-| Parse an `ImportHashed`

    This corresponds to the @import-hashed@ rule from the official grammar
-}
importHashed_ :: Parser ImportHashed
importHashed_ :: Parser ImportHashed
importHashed_ = do
    ImportType
importType <- Parser ImportType
importType_
    Maybe SHA256Digest
hash       <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
nonemptyWhitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SHA256Digest
importHash_))
    forall (m :: * -> *) a. Monad m => a -> m a
return (ImportHashed {Maybe SHA256Digest
ImportType
importType :: ImportType
hash :: Maybe SHA256Digest
hash :: Maybe SHA256Digest
importType :: ImportType
..})

{-| Parse an `Import`

    This corresponds to the @import@ rule from the official grammar
-}
import_ :: Parser Import
import_ :: Parser Import
import_ = (do
    ImportHashed
importHashed <- Parser ImportHashed
importHashed_
    ImportMode
importMode   <- Parser ImportMode
alternative forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
Code
    forall (m :: * -> *) a. Monad m => a -> m a
return (Import {ImportHashed
ImportMode
importMode :: ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
..}) ) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"import"
  where
    alternative :: Parser ImportMode
alternative = do
      forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_as forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

      (Parser ()
_Text forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
RawText)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
_Location forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
Location)
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
_Bytes forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
RawBytes)

-- | 'ApplicationExprInfo' distinguishes certain subtypes of application
-- expressions.
data ApplicationExprInfo
    = NakedMergeOrSomeOrToMap
    -- ^ @merge x y@, @Some x@ or @toMap x@, unparenthesized.
    | ImportExpr
    -- ^ An import expression.
    | ApplicationExpr
    -- ^ Any other application expression.