{-# 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.ByteArray.Encoding (Base (..))
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.ByteArray.Encoding
import qualified Data.ByteString
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 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 :: m Int
getOffset = State s e -> Int
forall s e. State s e -> Int
Text.Megaparsec.stateOffset (State s e -> Int) -> m (State s e) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (State s e)
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 :: Int -> m ()
setOffset Int
o = (State s e -> State s e) -> m ()
forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
Text.Megaparsec.updateParserState ((State s e -> State s e) -> m ())
-> (State s e -> State s e) -> m ()
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 :: Parser a -> Parser Src
src Parser a
parser = do
    SourcePos
before      <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, a
_) <- Parser a -> Parser (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
    SourcePos
after       <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    Src -> Parser Src
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 :: Parser a -> Parser (Src, a)
srcAnd Parser a
parser = do
    SourcePos
before      <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, a
x) <- Parser a -> Parser (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
    SourcePos
after       <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Src, a) -> Parser (Src, a)
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 :: Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
parser = do
    SourcePos
before      <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (Text
tokens, Expr Src a
e) <- Parser (Expr Src a) -> Parser (Tokens Text, Expr Src a)
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       <- Parser SourcePos
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₁ -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
e
        Expr Src a
_                                -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src -> Expr Src a -> Expr Src a
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 :: Parser a -> Parser (Expr Src a)
completeExpression Parser a
embedded = Parser (Expr Src a)
completeExpression_
  where
    Parsers {Parser (Expr Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..} = Parser a -> Parsers 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 :: Parser a -> Parser (Expr Src a)
importExpression Parser a
embedded = Parser (Expr Src a)
importExpression_
  where
    Parsers {Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
..} = Parser a -> Parsers 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
    { Parsers a -> Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
    , Parsers a -> Parser (Expr Src a)
importExpression_   :: Parser (Expr Src a)
    }

-- | Given a parser for imports,
parsers :: forall a. Parser a -> Parsers a
parsers :: Parser a -> Parsers a
parsers Parser a
embedded = Parsers :: forall a. Parser (Expr Src a) -> Parser (Expr Src a) -> Parsers a
Parsers {Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..}
  where
    completeExpression_ :: Parser (Expr Src a)
completeExpression_ =
        Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
shebang Parser [Text] -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace

    shebang :: Parser Text
shebang = do
        Text
_ <- Text -> Parser Text
text Text
"#!"

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

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

        Parser Text
endOfLine

    expression :: Parser (Expr Src a)
expression =
        Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted
            ( [Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative0
                , Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative1
                , Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative2
                , Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative3
                , Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative4
                , Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative5
                ]
            ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
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 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
            Text
a <- Parser Text
label
            Src
src1 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
            Parser ()
_colon
            Src
src2 <- Parser () -> Parser Src
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
            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> FunctionBinding Src a -> Expr Src a -> Expr Src a
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam (CharacterSet -> Maybe CharacterSet
forall a. a -> Maybe a
Just (CharacterSet
cs CharacterSet -> CharacterSet -> CharacterSet
forall a. Semigroup a => a -> a -> a
<> CharacterSet
cs')) (Maybe Src
-> Text
-> Maybe Src
-> Maybe Src
-> Expr Src a
-> FunctionBinding Src a
forall s a.
Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
FunctionBinding (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src0) Text
a (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src1) (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src2) Expr Src a
b) Expr Src a
c)

        alternative1 :: Parser (Expr Src a)
alternative1 = do
            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_if Parser () -> Parser () -> Parser ()
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
            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_then Parser () -> Parser () -> Parser ()
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
            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_else Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
            Expr Src a
c <- Parser (Expr Src a)
expression
            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a -> Expr Src a
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
            let binding :: Parser (Binding Src a)
binding = do
                    Src
src0 <- Parser Src -> Parser Src
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_let Parser () -> Parser Src -> Parser Src
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace)

                    Text
c <- Parser Text
label

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

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

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

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

                        Parser ()
whitespace

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

                    Parser ()
_equal

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

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

                    Parser ()
whitespace

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

            NonEmpty (Binding Src a)
as <- Parser (Binding Src a) -> Parser (NonEmpty (Binding Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NonEmpty.some1 Parser (Binding Src a)
binding

            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_in Parser () -> Parser () -> Parser ()
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 …
            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Binding Src a) -> Expr Src a -> Expr Src a
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 <- Parser CharacterSet -> Parser CharacterSet
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser CharacterSet
_forall Parser CharacterSet -> Parser () -> Parser CharacterSet
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace Parser CharacterSet -> Parser () -> Parser CharacterSet
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
            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> Text -> Expr Src a -> Expr Src a -> Expr Src a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi (CharacterSet -> Maybe CharacterSet
forall a. a -> Maybe a
Just (CharacterSet
cs CharacterSet -> CharacterSet -> CharacterSet
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
            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_assert Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser () -> Parser ()
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
            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a
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 (Expr Src a -> Parser (Expr Src a)
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 -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        ApplicationExprInfo
_          -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty

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

                        NonEmpty Text
keys <- Parser Text -> Parser () -> Parser (NonEmpty Text)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
Combinators.NonEmpty.sepBy1 Parser Text
anyLabel (Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot) Parser () -> Parser () -> Parser ()
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

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

                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr Src a -> (Expr Src a -> Expr Src a) -> Expr Src a)
-> Expr Src a -> [Expr Src a -> Expr Src a] -> Expr Src a
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
                            Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> Text -> Expr Src a -> Expr Src a -> Expr Src a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi (CharacterSet -> Maybe CharacterSet
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 (Expr Src a -> Expr Src a
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)
applicationExpression

                                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr Src a) -> Seq (Expr Src a) -> Expr Src a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (Expr Src a -> Maybe (Expr Src a)
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)
applicationExpression

                                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Maybe (Expr Src a) -> Expr Src a
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 (Expr Src a -> Maybe (Expr Src a)
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)
applicationExpression

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

                                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
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 Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
a of
                                ListLit Maybe (Expr Src a)
Nothing [] ->
                                    String -> Parser (Expr Src a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list literal without annotation"
                                Expr Src a
_ -> Expr Src a -> Parser (Expr Src a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a

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

            Parser (Expr Src a)
alternative5A Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
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 =
        (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)))
-> (Parser (Expr Src a), Parser (Expr Src a))
-> [Parser (Expr Src a -> Expr Src a -> Expr Src a)]
-> (Parser (Expr Src a), Parser (Expr Src a))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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))
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 [Parser (Expr Src a -> Expr Src a -> Expr Src a)]
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) =
            ( Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
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
            , Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
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 <- Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Expr Src a -> Expr Src a)
 -> Parser [Expr Src a -> Expr Src a])
-> Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall a b. (a -> b) -> a -> b
$ do
                (Src SourcePos
_ SourcePos
_ Text
textOp, Expr Src a -> Expr Src a -> Expr Src a
op0) <- Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Src, Expr Src a -> Expr Src a -> Expr Src a)
forall a. Parser a -> Parser (Src, a)
srcAnd (Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser ()
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
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
_) =
                        Src -> Expr Src a -> 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textOp Text -> Text -> Text
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

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

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

    applicationExpression :: Parser (Expr Src a)
applicationExpression = (ApplicationExprInfo, Expr Src a) -> Expr Src a
forall a b. (a, b) -> b
snd ((ApplicationExprInfo, Expr Src a) -> Expr Src a)
-> Parser (ApplicationExprInfo, Expr Src a) -> Parser (Expr Src a)
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
                    Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_merge Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

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

                    (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr Src a
b -> Expr Src a -> Expr Src a -> Maybe (Expr Src a) -> Expr Src a
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 Maybe (Expr Src a)
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"second argument to ❰merge❱")

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

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

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

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

            let alternative3 :: Parser (a -> a, Maybe a)
alternative3 =
                    (a -> a, Maybe a) -> Parser (a -> a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
forall a. a -> a
id, Maybe a
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 Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a -> Expr Src a, Maybe String)
forall s a. Parser (Expr s a -> Expr s a, Maybe String)
alternative1 Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a -> Expr Src a, Maybe String)
forall s a. Parser (Expr s a -> Expr s a, Maybe String)
alternative2 Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a -> Expr Src a, Maybe String)
forall a a. Parser (a -> a, Maybe a)
alternative3

            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 m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
message

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

            [(Text, Expr Src a)]
bs <- Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)])
-> (Parser (Text, Expr Src a) -> Parser (Text, Expr Src a))
-> Parser (Text, Expr Src a)
-> Parser [(Text, Expr Src a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)])
-> Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)]
forall a b. (a -> b) -> a -> b
$ do
                (Text
sep, ()
_) <- Parser () -> Parser (Tokens Text, ())
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_
                (Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sep, Expr Src a
b)

            let c :: Expr Src a
c = (Expr Src a -> (Text, Expr Src a) -> Expr Src a)
-> Expr Src a -> [(Text, Expr Src a)] -> Expr Src a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Expr Src a -> (Text, Expr Src a) -> Expr Src a
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

            (ApplicationExprInfo, Expr Src a)
-> Parser (ApplicationExprInfo, Expr Src a)
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
                = Src -> Expr Src a -> Expr Src a
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
left SourcePos
right (Text
bytesL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bytesR)) (Expr Src a -> Expr Src a -> Expr Src a
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) =
                Expr Src a -> Expr Src a -> Expr Src a
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_ = Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted ([Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Item [Parser (Expr Src a)]
forall s. Parser (Expr s a)
alternative0, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative1 ])
          where
            alternative0 :: Parser (Expr s a)
alternative0 = do
                a
a <- Parser a
embedded
                Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Expr s a
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 = Parser (Expr Src a) -> Parser (Expr Src a)
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 <- Parser (Expr Src a) -> Parser (Maybe (Expr Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
            Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
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 -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a
            Just Expr Src a
b  -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
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 = Parser (Expr Src a) -> Parser (Expr Src a)
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 Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
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 = Expr s a -> FieldSelection s -> Expr s a
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 = Expr s a -> Either [Text] (Expr s a) -> Expr s a
forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
e ([Text] -> Either [Text] (Expr s a)
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 = Expr s a -> Either [Text] (Expr s a) -> Expr s a
forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
e (Expr s a -> Either [Text] (Expr s a)
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 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace

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

                            SourcePos
pos <- Parser SourcePos
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
""

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

                    let result :: Parser (Expr Src a -> Expr Src a)
result =
                                (FieldSelection Src -> Expr Src a -> Expr Src a)
-> Parser (FieldSelection Src) -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldSelection Src -> Expr Src a -> Expr Src a
forall s a. FieldSelection s -> Expr s a -> Expr s a
field               Parser (FieldSelection Src)
fieldSelection
                            Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Text] -> Expr Src a -> Expr Src a)
-> Parser [Text] -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Expr Src a -> Expr Src a
forall s a. [Text] -> Expr s a -> Expr s a
projectBySet        Parser [Text]
labels
                            Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a) -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src a -> Expr Src a -> Expr Src a
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 <- Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot Parser ()
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a -> Expr Src a)
alternatives))

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

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

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

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

                Src
src0 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
                Maybe ()
mComma <- Parser () -> Parser (Maybe ())
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 -> Src -> Parser Src
forall (m :: * -> *) a. Monad m => a -> m a
return Src
src0
                    Just ()
_ -> Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace

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

                Parser ()
_closeBrace

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

            alternative09 :: Parser (Expr s a)
alternative09 = do
                Double
a <- Parser Double -> Parser Double
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Double
doubleInfinity
                Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'N'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'I'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'L'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'O'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'B'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'S'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'F'
                        Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'K'

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

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

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

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

            alternative37 :: Parser (Expr s a)
alternative37 = do
                Var
a <- Parser Var
identifier
                Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
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
                Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a

    doubleQuotedChunk :: Parser (Chunks Src a)
doubleQuotedChunk =
            [Parser (Chunks Src a)] -> Parser (Chunks Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
interpolation
                , Item [Parser (Chunks Src a)]
forall s a. Parser (Chunks s a)
unescapedCharacterFast
                , Item [Parser (Chunks Src a)]
forall s a. Parser (Chunks s a)
unescapedCharacterSlow
                , Item [Parser (Chunks Src a)]
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
'}'
                Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text
forall a. Monoid a => a
mempty, Expr Src a
e)] Text
forall a. Monoid a => a
mempty)

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

            unescapedCharacterSlow :: Parser (Chunks s a)
unescapedCharacterSlow = do
                Char
_ <- Char -> Parser Char
char Char
'$'
                Chunks s a -> Parser (Chunks s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr s a)] -> Text -> Chunks s a
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 <- [Parser Char] -> Parser Char
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                    [ Item [Parser Char]
Parser Char
quotationMark
                    , Item [Parser Char]
Parser Char
dollarSign
                    , Item [Parser Char]
Parser Char
backSlash
                    , Item [Parser Char]
Parser Char
forwardSlash
                    , Item [Parser Char]
Parser Char
backSpace
                    , Item [Parser Char]
Parser Char
formFeed
                    , Item [Parser Char]
Parser Char
lineFeed
                    , Item [Parser Char]
Parser Char
carriageReturn
                    , Item [Parser Char]
Parser Char
tab
                    , Item [Parser Char]
Parser Char
unicode
                    ]
                Chunks s a -> Parser (Chunks s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr s a)] -> Text -> Chunks s a
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'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'

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

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

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

                tab :: Parser Char
tab = do Char
_ <- Char -> Parser Char
char Char
't'; Char -> Parser Char
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 = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\Int
x Int
y -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0

                    let fourCharacterEscapeSequence :: Parser Int
fourCharacterEscapeSequence = do
                            [Int]
ns <- Int -> Parser Int -> Parser [Int]
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

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

                            Int -> Parser Int
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 <- Parser Int -> Parser [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Int
hexNumber

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

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

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

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

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

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

    singleQuoteContinue :: Parser (Chunks Src a)
singleQuoteContinue =
            [Parser (Chunks Src a)] -> Parser (Chunks Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
                [ Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
escapeSingleQuotes
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
interpolation
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
escapeInterpolation
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
endLiteral
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
unescapedCharacterFast
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
unescapedCharacterSlow
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
tab
                , Item [Parser (Chunks Src a)]
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
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"''" Chunks Src a -> Chunks Src a -> 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
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text
forall a. Monoid a => a
mempty, Expr Src a
a)] Text
forall a. Monoid a => a
mempty Chunks Src a -> Chunks Src a -> Chunks Src a
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
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"${" Chunks Src a -> Chunks Src a -> 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
"''"
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Chunks Src a
forall a. Monoid a => a
mempty

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

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

                endOfLine_ :: Parser (Chunks Src a)
endOfLine_ = do
                    Text
a <- Parser Text
"\n" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
"\r\n"
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a Chunks Src a -> Chunks Src a -> Chunks Src 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' Parser Char -> String -> Parser Char
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"tab"
                    Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
                    Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"\t" Chunks Src a -> Chunks Src a -> Chunks Src a
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

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

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

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

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

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

    emptyRecordType :: Parser (Expr s a)
emptyRecordType = Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Record Map Text (RecordField s a)
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) <- Parser (Src, Text) -> Parser (Src, Text)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser (Src, Text) -> Parser (Src, Text))
-> Parser (Src, Text) -> Parser (Src, Text)
forall a b. (a -> b) -> a -> b
$ do
                        Text
a <- Parser Text
anyLabelOrSome
                        Src
s <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
                        Parser ()
_colon
                        (Src, Text) -> Parser (Src, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src
s, Text
a)

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

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

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

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

                        Parser ()
_colon

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

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

                        Parser ()
whitespace

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

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

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

                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField Src a) -> Expr Src a
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 -> Src -> Parser Src
forall (m :: * -> *) a. Monad m => a -> m a
return Src
src0
                        Maybe Src
Nothing -> Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
                    Text
firstLabel <- Parser Text
anyLabelOrSome
                    Src
firstSrc1 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace

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

                    [(Src, Text, Src)]
restKeys <- Parser (Src, Text, Src) -> Parser [(Src, Text, Src)]
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) (Src, Text, Src) -> [(Src, Text, Src)] -> NonEmpty (Src, Text, Src)
forall a. a -> [a] -> NonEmpty a
:| [(Src, Text, Src)]
restKeys

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

                            Src
lastSrc2 <- Parser () -> Parser Src
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, Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (s -> Maybe s
forall a. a -> Maybe a
Just s
s0) (Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit [ (Text
key', RecordField s a
values) ]) (s -> Maybe s
forall a. a -> Maybe a
Just s
s1) Maybe s
forall a. Maybe a
Nothing)

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

                            (Text, RecordField Src a) -> Parser (Text, RecordField Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (((Src, Text, Src)
 -> (Text, RecordField Src a) -> (Text, RecordField Src a))
-> (Text, RecordField Src a)
-> [(Src, Text, Src)]
-> (Text, RecordField Src a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Src, Text, Src)
-> (Text, RecordField Src a) -> (Text, RecordField Src a)
forall s a a.
(s, a, s) -> (Text, RecordField s a) -> (a, RecordField s a)
cons (Text, RecordField Src a)
nil (NonEmpty (Src, Text, Src) -> [(Src, Text, Src)]
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) :| [] -> (Text, RecordField Src a) -> Parser (Text, RecordField Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Maybe Src
-> Expr Src a -> Maybe Src -> Maybe Src -> RecordField Src a
forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
s0) (Var -> Expr Src a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
0)) (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
s1) Maybe Src
forall a. Maybe a
Nothing)
                                NonEmpty (Src, Text, Src)
_       -> Parser (Text, RecordField Src a)
forall (f :: * -> *) a. Alternative f => f a
empty

                    (Parser (Text, RecordField Src a)
normalRecordEntry Parser (Text, RecordField Src a)
-> Parser (Text, RecordField Src a)
-> Parser (Text, RecordField Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Text, RecordField Src a)
forall a. Parser (Text, RecordField Src a)
punnedEntry) Parser (Text, RecordField Src a)
-> Parser () -> Parser (Text, RecordField Src a)
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 (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
firstSrc0)

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

                    Maybe ()
_ <- Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
whitespace Parser () -> Parser () -> Parser ()
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 = (RecordField s a -> RecordField s a -> RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((RecordField s a -> RecordField s a -> RecordField s a)
 -> f (RecordField s a)
 -> f (RecordField s a)
 -> f (RecordField s a))
-> (RecordField s a -> RecordField s a -> RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
-> f (RecordField s a)
forall a b. (a -> b) -> a -> b
$ \RecordField s a
rf RecordField s a
rf' -> Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
makeRecordField (Expr s a -> RecordField s a) -> Expr s a -> RecordField s a
forall a b. (a -> b) -> a -> b
$ Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine Maybe CharacterSet
forall a. Monoid a => a
mempty (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
k)
                                                            (RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue RecordField s a
rf')
                                                            (RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue RecordField s a
rf)

                    Map Text (RecordField Src a)
m <- (Text
 -> Parser (RecordField Src a)
 -> Parser (RecordField Src a)
 -> Parser (RecordField Src a))
-> [(Text, RecordField Src a)]
-> Parser (Map Text (RecordField Src a))
forall a.
(Text -> Parser a -> Parser a -> Parser a)
-> [(Text, a)] -> Parser (Map Text a)
toMapWith Text
-> Parser (RecordField Src a)
-> Parser (RecordField Src a)
-> Parser (RecordField Src a)
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 (Text, RecordField Src a)
-> [(Text, RecordField Src a)] -> [(Text, RecordField Src a)]
forall a. a -> [a] -> [a]
: [(Text, RecordField Src a)]
as)

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

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

                    (Text, Maybe (Expr Src a)) -> Parser (Text, Maybe (Expr Src a))
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 <- Parser (Text, Maybe (Expr Src a))
-> Parser (Text, Maybe (Expr Src a))
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_bar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ())
-> Parser (Text, Maybe (Expr Src a))
-> Parser (Text, Maybe (Expr Src a))
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 <- Parser (Text, Maybe (Expr Src a))
-> Parser [(Text, Maybe (Expr Src a))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (Text, Maybe (Expr Src a))
-> Parser (Text, Maybe (Expr Src a))
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_bar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser ()
-> Parser (Text, Maybe (Expr Src a))
-> Parser (Text, Maybe (Expr Src a))
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 <- [(Text, Maybe (Expr Src a))]
-> Parser (Map Text (Maybe (Expr Src a)))
forall a. [(Text, a)] -> Parser (Map Text a)
toMap ((Text, Maybe (Expr Src a))
kv (Text, Maybe (Expr Src a))
-> [(Text, Maybe (Expr Src a))] -> [(Text, Maybe (Expr Src a))]
forall a. a -> [a] -> [a]
: [(Text, Maybe (Expr Src a))]
kvs)

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

                    Parser ()
_closeAngle

                    Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Maybe (Expr Src a)) -> Expr Src a
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
                    Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_bar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeAngle)

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

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

            Parser (Expr Src a)
nonEmptyUnionType Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
forall s a. Parser (Expr s a)
emptyUnionType ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
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 <- Parser (Expr Src a) -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression)

                    Parser ()
whitespace

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

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

                    Parser ()
_closeBracket

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

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

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

            Parser (Expr Src a)
nonEmptyListLiteral Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
forall s a. Parser (Expr s a)
emptyListLiteral) Parser (Expr Src a) -> String -> Parser (Expr Src a)
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 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
alternative1)
    ImportType -> Parser ImportType
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
'"'
        Text -> Parser Text
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 =
    [Parser ImportType] -> Parser ImportType
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
        [ Item [Parser ImportType]
Parser ImportType
parentPath
        , Item [Parser ImportType]
Parser ImportType
herePath
        , Item [Parser ImportType]
Parser ImportType
homePath
        , Parser ImportType -> Parser ImportType
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

        ImportType -> Parser ImportType
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

        ImportType -> Parser ImportType
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

        ImportType -> Parser ImportType
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

        ImportType -> Parser ImportType
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
    ImportType -> Parser ImportType
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 <- Parser (Expr Src Import) -> Parser (Maybe (Expr Src Import))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
        Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_using Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
        Parser Import -> Parser (Expr Src Import)
forall a. Parser a -> Parser (Expr Src a)
importExpression Parser Import
import_ )
    ImportType -> Parser ImportType
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
  ImportType -> Parser ImportType
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'h' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'm'

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

    [Parser ImportType] -> Parser ImportType
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Item [Parser ImportType]
Parser ImportType
local, Item [Parser ImportType]
Parser ImportType
http, Item [Parser ImportType]
Parser ImportType
env, Item [Parser ImportType]
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 <- Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
64 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig Parser Text -> String -> Parser Text
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 Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
Data.ByteArray.Encoding.convertFromBase Base
Base16 ByteString
strictBytes16 of
        Left  String
string      -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
string
        Right ByteString
strictBytes -> ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
strictBytes :: Data.ByteString.ByteString)
    case ByteString -> Maybe SHA256Digest
Dhall.Crypto.sha256DigestFromByteString ByteString
strictBytes of
      Maybe SHA256Digest
Nothing -> String -> Parser SHA256Digest
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid sha256 hash"
      Just SHA256Digest
h  -> SHA256Digest -> Parser SHA256Digest
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       <- Parser SHA256Digest -> Parser (Maybe SHA256Digest)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser SHA256Digest -> Parser SHA256Digest
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
nonemptyWhitespace Parser () -> Parser SHA256Digest -> Parser SHA256Digest
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SHA256Digest
importHash_))
    ImportHashed -> Parser ImportHashed
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
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 Parser ImportMode -> Parser ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
Code
    Import -> Parser Import
forall (m :: * -> *) a. Monad m => a -> m a
return (Import :: ImportHashed -> ImportMode -> Import
Import {ImportHashed
ImportMode
importMode :: ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
..}) ) Parser Import -> String -> Parser Import
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"import"
  where
    alternative :: Parser ImportMode
alternative = do
      Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_as Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

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

-- | '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.