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

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

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

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

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

-- | Get the current source offset (in tokens)
getOffset :: Text.Megaparsec.MonadParsec e s m => m Int
getOffset :: forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset = 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 :: forall e s (m :: * -> *). MonadParsec e s m => 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
        { Text.Megaparsec.stateOffset = o }
{-# INLINE setOffset #-}

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

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

{-| Wrap a `Parser` to still match the same text, but to wrap the resulting
    `Expr` in a `Note` constructor containing the `Src` span
-}
noted :: Parser (Expr Src a) -> Parser (Expr Src a)
noted :: forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
parser = do
    before      <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
    (tokens, e) <- Text.Megaparsec.match parser
    after       <- Text.Megaparsec.getSourcePos
    let src₀ = SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens
    case e of
        Note Src
src₁ Expr Src a
_ | Src -> Src -> Bool
laxSrcEq Src
src₀ Src
src₁ -> Expr Src a -> Parser (Expr Src a)
forall a. a -> Parser 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 a. a -> Parser 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 :: forall a. Parser a -> Parser (Expr Src a)
completeExpression Parser a
embedded = Parser (Expr Src a)
completeExpression_
  where
    Parsers {Parser (Expr Src a)
Parser (Binding Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
letBinding :: Parser (Binding Src a)
letBinding :: forall a. Parsers a -> Parser (Binding Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
..} = 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 :: forall a. Parser a -> Parser (Expr Src a)
importExpression Parser a
embedded = Parser (Expr Src a)
importExpression_
  where
    Parsers {Parser (Expr Src a)
Parser (Binding Src a)
letBinding :: forall a. Parsers a -> Parser (Binding Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
letBinding :: Parser (Binding 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
    { forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
    , forall a. Parsers a -> Parser (Expr Src a)
importExpression_   :: Parser (Expr Src a)
    , forall a. Parsers a -> Parser (Binding Src a)
letBinding          :: Parser (Binding Src a)
    }

{-| Parse a numeric `TimeZone`

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

    hour <- timeHour

    _ <- text ":"

    minute <- timeMinute

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

    return (TimeZoneLiteral (Time.TimeZone minutes Prelude.False ""))

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

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

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

{-| Parse a `Time`

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

    _ <- text ":"

    minute <- timeMinute

    _ <- text ":"

    second <- timeSecond

    (fraction, precision) <- timeSecFrac <|> pure (0, 0)

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

    return (TimeLiteral time precision)

{-| Parse a `Date`

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

    _ <- text "-"

    month <- dateMonth

    _ <- text "-"

    day <- dateMday

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

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

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

            _ <- text "T" <|> text "t"

            time <- partialTime

            timeZone <- timeOffset

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

            _ <- text "T" <|> text "t"

            time <- partialTime

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

            timeZone <- timeOffset

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

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

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

    _ <- Dhall.Parser.Combinators.takeWhile predicate

    _ <- endOfLine

    return ()

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

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

        c <- label

        src1 <- src whitespace

        d <- optional (do
            _colon

            src2 <- src nonemptyWhitespace

            e <- expression

            whitespace

            return (Just src2, e) )

        _equal

        src3 <- src whitespace

        f <- expression

        whitespace

        return (Binding (Just src0) c (Just src1) d (Just src3) f)

    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 a. Parser a -> String -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"expression"
      where
        alternative0 :: Parser (Expr Src a)
alternative0 = do
            cs <- Parser CharacterSet
_lambda
            whitespace
            _openParens
            src0 <- src whitespace
            a <- label
            src1 <- src whitespace
            _colon
            src2 <- src nonemptyWhitespace
            b <- expression
            whitespace
            _closeParens
            whitespace
            cs' <- _arrow
            whitespace
            c <- expression
            return (Lam (Just (cs <> cs')) (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c)

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

        alternative2 :: Parser (Expr Src a)
alternative2 = do
            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)
letBinding

            try (_in *> nonemptyWhitespace)

            b <- 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 …
            return (Dhall.Syntax.wrapInLets as b)

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

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

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

            let (parseFirstOperatorExpression, parseOperatorExpression) =
                    operatorExpression (pure a0)

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

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

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

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

                        whitespace

                        _equal

                        whitespace

                        value <- parseOperatorExpression

                        return (\Expr Src a
e -> Expr Src a -> NonEmpty WithComponent -> Expr Src a -> Expr Src a
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With Expr Src a
e NonEmpty WithComponent
keys Expr Src a
value) )

                    return (foldl (\Expr Src a
e Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
e) a0 bs)

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

                    whitespace

                    let alternative5B0 = do
                            cs <- Parser CharacterSet
_arrow
                            whitespace
                            b <- expression
                            whitespace
                            return (Pi (Just cs) "_" a b)

                    let 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
                                    b <- Parser (Expr Src a)
expression

                                    return (ListLit (Just b) [])
                                (Merge Expr Src a
c Expr Src a
d Maybe (Expr Src a)
Nothing, ApplicationExprInfo
NakedMergeOrSomeOrToMap) -> do
                                    b <- Parser (Expr Src a)
expression

                                    return (Merge c d (Just b))
                                (ToMap Expr Src a
c Maybe (Expr Src a)
Nothing, ApplicationExprInfo
NakedMergeOrSomeOrToMap) -> do
                                    b <- Parser (Expr Src a)
expression

                                    return (ToMap c (Just b))
                                (Expr Src a, ApplicationExprInfo)
_ -> do
                                    b <- Parser (Expr Src a)
expression

                                    return (Annot a b)

                    let 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 a. String -> Parser 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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a

                    alternative5B0 <|> alternative5B1 <|> alternative5B2

            alternative5A <|> 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 a b. (a -> b -> b) -> b -> [a] -> b
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
            a <- Parser (Expr Src a)
firstSubExpression

            bs <- Text.Megaparsec.many $ do
                (Src _ _ textOp, op0) <- srcAnd (try (whitespace *> operatorParser))

                r0 <- subExpression

                let l :: Expr Src a
l@(Note (Src SourcePos
startL SourcePos
_ Text
textL) 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

                return (`op` r0)

            return (foldl' (\Expr Src a
x Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
x) a bs)

    operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
    operatorParsers :: forall s. [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers =
        [ 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
        , (\CharacterSet
cs -> Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer (CharacterSet -> Maybe CharacterSet
forall a. a -> Maybe a
Just CharacterSet
cs) PreferAnnotation
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 a b. Parser a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_doubleEqual Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ()
forall a. Parser a -> 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 a b. Parser a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser 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 a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_merge Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)

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

                    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, Just "second argument to ❰merge❱")

            let alternative1 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative1 = do
                    Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_Some Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
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 a. a -> Parser a
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 a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_toMap Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
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 a. a -> Parser a
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 (Expr s a -> Expr s a, Maybe String)
alternative3 = do
                    Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_showConstructor Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr s a
a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
ShowConstructor Expr s a
a, String -> Maybe String
forall a. a -> Maybe a
Just String
"argument to ❰showConstructor❱")

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

            (f, 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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
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)
alternative3 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 a. Parser a -> Parser a -> Parser a
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)
alternative4

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

            a <- adapt (noted importExpression_)

            bs <- Text.Megaparsec.many . try $ do
                (sep, _) <- Text.Megaparsec.match nonemptyWhitespace
                b <- importExpression_
                return (sep, b)

            let c = (Expr Src a -> (Text, Expr Src a) -> Expr Src a)
-> Expr Src a -> [(Text, Expr Src a)] -> Expr Src a
forall b a. (b -> a -> b) -> b -> [a] -> b
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 =
                    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

            return (info, 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)]
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 <- Parser a
embedded
                return (Embed 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
        a <- Parser (Expr Src a)
selectorExpression

        mb <- optional (do
            try (whitespace *> _doubleColon)

            whitespace

            selectorExpression )

        case mb of
            Maybe (Expr Src a)
Nothing -> Expr Src a -> Parser (Expr Src a)
forall a. a -> Parser 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 a. a -> Parser 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
            a <- Parser (Expr Src a)
primitiveExpression

            let recordType = Parser ()
_openParens Parser () -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall a b. Parser a -> Parser b -> Parser b
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 a b. Parser a -> Parser b -> Parser 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 a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
_closeParens

            let 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]
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
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 = do
                    src0 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace

                    let fieldSelection = do
                            l <- Parser Text
anyLabel

                            pos <- 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 = SourcePos -> SourcePos -> Text -> Src
Src SourcePos
pos SourcePos
pos Text
""

                            return (FieldSelection (Just src0) l (Just src1))

                    let result =
                                (FieldSelection Src -> Expr Src a -> Expr Src a)
-> Parser (FieldSelection Src) -> Parser (Expr Src a -> Expr Src a)
forall a b. (a -> b) -> Parser a -> Parser b
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 a. Parser a -> Parser a -> Parser 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 a b. (a -> b) -> Parser a -> Parser b
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 a. Parser a -> Parser a -> Parser 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 a b. (a -> b) -> Parser a -> Parser b
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

                    result

            b <- Text.Megaparsec.many (try (whitespace *> _dot *> alternatives))

            return (foldl' (\Expr Src a
e Expr Src a -> Expr Src a
k -> Expr Src a -> Expr Src a
k Expr Src a
e) 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)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
bytesLiteral
                    , Item [Parser (Expr Src a)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
temporalLiteral
                    , Item [Parser (Expr Src a)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
alternative00
                    , Item [Parser (Expr Src a)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
alternative01
                    , Item [Parser (Expr Src a)]
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)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
alternative37
                    , Item [Parser (Expr Src a)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
alternative09
                    , Item [Parser (Expr Src a)]
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 a. Parser a -> Parser a -> Parser 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
                n <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
                a <- try doubleLiteral
                b <- if isInfinite a
                       then setOffset n *> fail "double out of bounds"
                       else return a
                return (DoubleLit (DhallDouble b))

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

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

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

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

                a <- recordTypeOrLiteral src1

                _closeBrace

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

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

                c <- Parser Char -> Parser Char
forall a. Parser a -> Parser a
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 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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
DateShow         Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_DateShow
                            , Expr s a
forall s a. Expr s a
Date             Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Date
                            , Expr s a
forall s a. Expr s a
DoubleShow       Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Optional
                    Char
'B' ->
                        [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
Bool             Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Bool
                            , Expr s a
forall s a. Expr s a
Bytes            Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Bytes
                            ]
                    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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Text
                            , Expr s a
forall s a. Expr s a
TimeZoneShow     Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeZoneShow
                            , Expr s a
forall s a. Expr s a
TimeZone         Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeZone
                            , Expr s a
forall s a. Expr s a
TimeShow         Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TimeShow
                            , Expr s a
forall s a. Expr s a
Time             Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Time
                            , Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit Bool
True     Expr s a -> Parser () -> Parser (Expr s a)
forall a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser 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 a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Kind
                    Char
_   ->    Parser (Expr s a)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

            alternative37 :: Parser (Expr s a)
alternative37 = do
                a <- Parser Var
identifier
                return (Var a)

            alternative38 :: Parser (Expr Src a)
alternative38 = do
                Parser ()
_openParens
                Parser ()
whitespace
                a <- Parser (Expr Src a)
expression
                whitespace
                _closeParens
                return 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)]
Parser (Chunks Src a)
forall {s} {a}. Parser (Chunks s a)
unescapedCharacterFast
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
forall {s} {a}. Parser (Chunks s a)
unescapedCharacterSlow
                , Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
forall {s} {a}. Parser (Chunks s a)
escapedCharacter
                ]
          where
            interpolation :: Parser (Chunks Src a)
interpolation = do
                _ <- Text -> Parser Text
text Text
"${"
                e <- completeExpression_
                _ <- char '}'
                return (Chunks [(mempty, e)] mempty)

            unescapedCharacterFast :: Parser (Chunks s a)
unescapedCharacterFast = do
                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
                return (Chunks [] 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 -> Parser Char
char Char
'$'
                return (Chunks [] "$")

            escapedCharacter :: Parser (Chunks s a)
escapedCharacter = do
                _ <- Char -> Parser Char
char Char
'\\'
                c <- choice
                    [ quotationMark
                    , dollarSign
                    , backSlash
                    , forwardSlash
                    , backSpace
                    , formFeed
                    , lineFeed
                    , carriageReturn
                    , tab
                    , unicode
                    ]
                return (Chunks [] (Data.Text.singleton 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 -> Parser Char
char Char
'b'; return '\b'

                formFeed :: Parser Char
formFeed = do _ <- Char -> Parser Char
char Char
'f'; return '\f'

                lineFeed :: Parser Char
lineFeed = do _ <- Char -> Parser Char
char Char
'n'; return '\n'

                carriageReturn :: Parser Char
carriageReturn = do _ <- Char -> Parser Char
char Char
'r'; return '\r'

                tab :: Parser Char
tab = do _ <- Char -> Parser Char
char Char
't'; return '\t'

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

                    let toNumber = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = do
                            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] -> Int
toNumber [Int]
ns

                            Control.Monad.guard (validCodepoint number)
                                <|> fail "Invalid Unicode code point"

                            return number

                    let bracedEscapeSequence = do
                            _  <- Char -> Parser Char
char Char
'{'
                            ns <- some hexNumber

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

                            Control.Monad.guard (number <= 0x10FFFD && validCodepoint number)
                                <|> fail "Invalid Unicode code point"

                            _  <- char '}'

                            return number

                    n <- bracedEscapeSequence <|> fourCharacterEscapeSequence

                    return (Char.chr n)

    doubleQuotedLiteral :: Parser (Chunks Src a)
doubleQuotedLiteral = do
            _      <- Char -> Parser Char
char Char
'"'
            chunks <- Text.Megaparsec.many doubleQuotedChunk
            _      <- char '"'
            return (mconcat 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
                    _ <- Parser Text
"'''" :: Parser Text
                    b <- singleQuoteContinue
                    return ("''" <> b)

                interpolation :: Parser (Chunks Src a)
interpolation = do
                    _ <- Text -> Parser Text
text Text
"${"
                    a <- completeExpression_
                    _ <- char '}'
                    b <- singleQuoteContinue
                    return (Chunks [(mempty, a)] mempty <> b)

                escapeInterpolation :: Parser (Chunks Src a)
escapeInterpolation = do
                    _ <- Text -> Parser Text
text Text
"''${"
                    b <- singleQuoteContinue
                    return ("${" <> b)

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

                unescapedCharacterFast :: Parser (Chunks Src a)
unescapedCharacterFast = do
                    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
                    b <- singleQuoteContinue
                    return (Chunks [] 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
                    a <- (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate
                    b <- singleQuoteContinue
                    return (Chunks [] 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
                    a <- Parser Text
"\n" Parser Text -> Parser Text -> Parser Text
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
"\r\n"
                    b <- singleQuoteContinue
                    return (Chunks [] a <> b)

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

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

            _ <- endOfLine

            a <- singleQuoteContinue

            return (Dhall.Syntax.toDoubleQuoted a)

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

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

        let byte = do
                nibble0 <- (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
hexdig
                nibble1 <- Text.Megaparsec.satisfy hexdig
                return ([nibble0, nibble1] `base` 16)

        bytes <- Text.Megaparsec.many byte

        _ <- char '"'

        return (BytesLit (ByteString.pack bytes)) ) Parser (Expr s a) -> String -> Parser (Expr s a)
forall a. Parser a -> String -> Parser 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)]
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)]
Parser (Expr Src a)
forall s a. Parser (Expr s a)
emptyRecordType
                ]

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

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

        whitespace
        return (RecordLit mempty)

    emptyRecordType :: Parser (Expr s a)
emptyRecordType = Expr s a -> Parser (Expr s a)
forall a. a -> Parser 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
                    (firstKeySrc1, a) <- Parser (Src, Text) -> Parser (Src, Text)
forall a. Parser a -> Parser a
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
                        a <- Parser Text
anyLabelOrSome
                        s <- src whitespace
                        _colon
                        return (s, a)

                    firstKeySrc2 <- src nonemptyWhitespace

                    b <- expression

                    e <- Text.Megaparsec.many $ do
                        (src0', c) <- try $ do
                            _comma
                            src0' <- src whitespace
                            c <- anyLabelOrSome
                            return (src0', c)

                        src1 <- src whitespace

                        _colon

                        src2 <- src nonemptyWhitespace

                        d <- expression

                        whitespace

                        return (c, RecordField (Just src0') d (Just src1) (Just src2))

                    _ <- optional (whitespace *> _comma)
                    whitespace

                    m <- toMap ((a, RecordField (Just firstSrc0) b (Just firstKeySrc1) (Just firstKeySrc2)) : e)

                    return (Record m)

            let keysValue :: Maybe Src -> Parser (Text, RecordField Src a)
keysValue Maybe Src
maybeSrc = do
                    firstSrc0' <- case Maybe Src
maybeSrc of
                        Just Src
src0 -> Src -> Parser Src
forall a. a -> Parser a
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
                    firstLabel <- anyLabelOrSome
                    firstSrc1 <- src whitespace

                    let parseLabelWithWhsp = Parser (Src, Text, Src) -> Parser (Src, Text, Src)
forall a. Parser a -> Parser a
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
                            src0 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
                            l <- anyLabelOrSome
                            src1 <- src whitespace
                            return (src0, l, src1)

                    restKeys <- Combinators.many parseLabelWithWhsp
                    let 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 = do
                            Parser () -> Parser ()
forall a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser ()
_equal

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

                            value <- expression

                            let 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 (lastSrc0, lastLabel, lastSrc1) = NonEmpty.last keys
                            let 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))

                            return (foldr cons nil (NonEmpty.init keys))

                    let punnedEntry =
                            case NonEmpty (Src, Text, Src)
keys of
                                (Src
s0, Text
x, Src
s1) :| [] -> (Text, RecordField Src a) -> Parser (Text, RecordField Src a)
forall a. a -> Parser 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 a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

                    (normalRecordEntry <|> punnedEntry) <* whitespace

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

                    as <- many (try (_comma *> keysValue Nothing))

                    _ <- optional (whitespace *> _comma)

                    whitespace

                    let 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 a b c. (a -> b -> c) -> f a -> f b -> f c
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)

                    m <- toMapWith combine (a : as)

                    return (RecordLit m)

            Parser (Expr Src a)
nonEmptyRecordType Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser a -> Parser a -> Parser 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
                    a <- Parser Text
anyLabelOrSome

                    whitespace

                    b <- optional (_colon *> nonemptyWhitespace *> expression <* whitespace)

                    return (a, b)

            let nonEmptyUnionType :: Parser (Expr Src a)
nonEmptyUnionType = do
                    kv <- Parser (Text, Maybe (Expr Src a))
-> Parser (Text, Maybe (Expr Src a))
forall a. Parser a -> Parser 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 a b. Parser a -> Parser b -> Parser b
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 a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Maybe (Expr Src a))
unionTypeEntry)

                    kvs <- many (try (_bar *> whitespace *> unionTypeEntry))

                    m <- toMap (kv : kvs)

                    _ <- optional (_bar *> whitespace)

                    _closeAngle

                    return (Union m)

            let emptyUnionType :: Parser (Expr s a)
emptyUnionType = do
                    Parser () -> Parser ()
forall a. Parser a -> Parser 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 a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeAngle)

                    Expr s a -> Parser (Expr s a)
forall a. a -> Parser 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 a. Parser a -> Parser a -> Parser 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 a. Parser a -> String -> Parser 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
                    a <- Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser a -> Parser 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 a b. Parser a -> Parser b -> Parser b
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 a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression)

                    whitespace

                    as <- many (try (_comma *> whitespace *> expression) <* whitespace)

                    _ <- optional (_comma *> whitespace)

                    _closeBracket

                    return (ListLit Nothing (Data.Sequence.fromList (a : as)))

            let emptyListLiteral :: Parser (Expr s a)
emptyListLiteral = do
                    Parser () -> Parser ()
forall a. Parser a -> Parser 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 a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace) Parser (Maybe ()) -> Parser () -> Parser ()
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_closeBracket)

                    Expr s a -> Parser (Expr s a)
forall a. a -> Parser 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 a. Parser a -> Parser a -> Parser 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 a. Parser a -> String -> Parser 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 -> Parser Text
text Text
"env:"
    a <- (alternative0 <|> alternative1)
    return (Env a)
  where
    alternative0 :: Parser Text
alternative0 = Parser Text
bashEnvironmentVariable

    alternative1 :: Parser Text
alternative1 = do
        _ <- Char -> Parser Char
char Char
'"'
        a <- posixEnvironmentVariable
        _ <- char '"'
        return 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 a. Parser a -> Parser a
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser ImportType
absolutePath
        ]
  where
    parentPath :: Parser ImportType
parentPath = do
        _    <- Parser Text
".." :: Parser Text
        file <- file_ FileComponent

        return (Local Parent file)

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

        return (Local Here file)

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

        return (Local Home file)

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

        return (Local Absolute file)

{-| Parse a local import

    This corresponds to the @local@ rule from the official grammar
-}
local :: Parser ImportType
local :: Parser ImportType
local = do
    a <- Parser ImportType
localOnly
    return 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 <- Parser URL
httpRaw
    headers <- optional (do
        try (whitespace *> _using *> nonemptyWhitespace)
        importExpression import_ )
    return (Remote (url { 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 a. a -> Parser a
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'

    _ <- Parser (Token Text) -> Parser (Token Text)
forall a. Parser a -> Parser a
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)

    choice [ local, http, env, 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 -> Parser Text
text Text
"sha256:"
    t <- count 64 (satisfy hexdig <?> "hex digit")
    let strictBytes16 = Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
t
    strictBytes <- case Base16.decode strictBytes16 of
        Left  String
string      -> String -> Parser ByteString
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
string
        Right ByteString
strictBytes -> ByteString -> Parser ByteString
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
strictBytes
    case Dhall.Crypto.sha256DigestFromByteString strictBytes of
      Maybe SHA256Digest
Nothing -> String -> Parser SHA256Digest
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid sha256 hash"
      Just SHA256Digest
h  -> SHA256Digest -> Parser SHA256Digest
forall a. a -> Parser a
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 <- Parser ImportType
importType_
    hash       <- optional (try (nonemptyWhitespace *> importHash_))
    return (ImportHashed {..})

{-| Parse an `Import`

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

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

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