{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}

{-# OPTIONS_GHC -Wall #-}

-- | This module contains the logic for type checking Dhall code

module Dhall.TypeCheck (
    -- * Type-checking
      typeWith
    , typeOf
    , typeWithA
    , checkContext
    , messageExpressions

    -- * Types
    , Typer
    , X
    , absurd
    , TypeError(..)
    , DetailedTypeError(..)
    , Censored(..)
    , TypeMessage(..)
    , prettyTypeMessage
    , ErrorMessages(..)
    ) where

import Control.Exception                 (Exception)
import Control.Monad.Trans.Class         (lift)
import Control.Monad.Trans.Writer.Strict (execWriterT, tell)
import Data.List.NonEmpty                (NonEmpty (..))
import Data.Monoid                       (Endo (..))
import Data.Semigroup                    (Max (..))
import Data.Sequence                     (ViewL (..))
import Data.Set                          (Set)
import Data.Text                         (Text)
import Data.Typeable                     (Typeable)
import Data.Void                         (Void, absurd)
import Dhall.Context                     (Context)
import Dhall.Eval
    ( Environment (..)
    , Names (..)
    , Val (..)
    , (~>)
    )
import Dhall.Pretty                      (Ann)
import Dhall.Src                         (Src)
import Lens.Family                       (over)
import Prettyprinter                     (Doc, Pretty (..), vsep)

import Dhall.Syntax
    ( Binding (..)
    , Chunks (..)
    , Const (..)
    , Expr (..)
    , FunctionBinding (..)
    , PreferAnnotation (..)
    , RecordField (..)
    , Var (..)
    , WithComponent (..)
    )

import qualified Data.Foldable               as Foldable
import qualified Data.Foldable.WithIndex     as Foldable.WithIndex
import qualified Data.List.NonEmpty          as NonEmpty
import qualified Data.Map
import qualified Data.Sequence
import qualified Data.Set
import qualified Data.Text                   as Text
import qualified Data.Traversable
import qualified Dhall.Context
import qualified Dhall.Core
import qualified Dhall.Diff
import qualified Dhall.Eval                  as Eval
import qualified Dhall.Map
import qualified Dhall.Pretty
import qualified Dhall.Pretty.Internal
import qualified Dhall.Syntax                as Syntax
import qualified Dhall.Util
import qualified Lens.Family
import qualified Prettyprinter               as Pretty
import qualified Prettyprinter.Render.String as Pretty

{-| A type synonym for `Void`

    This is provided for backwards compatibility, since Dhall used to use its
    own `X` type instead of @"Data.Void".`Void`@.  You should use `Void` instead
    of `X` now
-}
type X = Void
{-# DEPRECATED X "Use Data.Void.Void instead" #-}

axiom :: Const -> Either (TypeError s a) Const
axiom :: Const -> Either (TypeError s a) Const
axiom Const
Type = Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
Kind
axiom Const
Kind = Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
Sort
axiom Const
Sort = TypeError s a -> Either (TypeError s a) Const
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
forall a. Context a
Dhall.Context.empty (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Sort) TypeMessage s a
forall s a. TypeMessage s a
Untyped)

rule :: Const -> Const -> Const
rule :: Const -> Const -> Const
rule Const
Type Const
Type = Const
Type
rule Const
Kind Const
Type = Const
Type
rule Const
Sort Const
Type = Const
Type
rule Const
Type Const
Kind = Const
Kind
rule Const
Kind Const
Kind = Const
Kind
rule Const
Sort Const
Kind = Const
Sort
rule Const
Type Const
Sort = Const
Sort
rule Const
Kind Const
Sort = Const
Sort
rule Const
Sort Const
Sort = Const
Sort

{-| Type-check an expression and return the expression's type if type-checking
    succeeds or an error if type-checking fails

    `typeWith` does not necessarily normalize the type since full normalization
    is not necessary for just type-checking.  If you actually care about the
    returned type then you may want to `Dhall.Core.normalize` it afterwards.

    The supplied `Context` records the types of the names in scope. If
    these are ill-typed, the return value may be ill-typed.
-}
typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
typeWith Context (Expr s X)
ctx Expr s X
expr = do
    Context (Expr s X) -> Either (TypeError s X) ()
forall s. Context (Expr s X) -> Either (TypeError s X) ()
checkContext Context (Expr s X)
ctx
    Typer X
-> Context (Expr s X)
-> Expr s X
-> Either (TypeError s X) (Expr s X)
forall a s.
(Eq a, Pretty a) =>
Typer a
-> Context (Expr s a)
-> Expr s a
-> Either (TypeError s a) (Expr s a)
typeWithA forall a. X -> a
Typer X
absurd Context (Expr s X)
ctx Expr s X
expr

{-| Function that converts the value inside an `Embed` constructor into a new
    expression
-}
type Typer a = forall s. a -> Expr s a

{-| Generalization of `typeWith` that allows type-checking the `Embed`
    constructor with custom logic
-}
typeWithA
    :: (Eq a, Pretty a)
    => Typer a
    -> Context (Expr s a)
    -> Expr s a
    -> Either (TypeError s a) (Expr s a)
typeWithA :: Typer a
-> Context (Expr s a)
-> Expr s a
-> Either (TypeError s a) (Expr s a)
typeWithA Typer a
tpa Context (Expr s a)
context Expr s a
expression =
    (Val a -> Expr s a)
-> Either (TypeError s a) (Val a)
-> Either (TypeError s a) (Expr s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expr X a -> Expr s a
forall a s. Expr X a -> Expr s a
Dhall.Core.renote (Expr X a -> Expr s a) -> (Val a -> Expr X a) -> Val a -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Val a -> Expr X a
forall a. Eq a => Names -> Val a -> Expr X a
Eval.quote Names
EmptyNames) (Typer a -> Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
forall a s.
(Eq a, Pretty a) =>
Typer a -> Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
infer Typer a
tpa Ctx a
ctx Expr s a
expression)
  where
    ctx :: Ctx a
ctx = Context (Expr s a) -> Ctx a
forall a s. Eq a => Context (Expr s a) -> Ctx a
contextToCtx Context (Expr s a)
context

contextToCtx :: Eq a => Context (Expr s a) -> Ctx a
contextToCtx :: Context (Expr s a) -> Ctx a
contextToCtx Context (Expr s a)
context = [(Text, Expr s a)] -> Ctx a
forall a s. Eq a => [(Text, Expr s a)] -> Ctx a
loop (Context (Expr s a) -> [(Text, Expr s a)]
forall a. Context a -> [(Text, a)]
Dhall.Context.toList Context (Expr s a)
context)
  where
    loop :: [(Text, Expr s a)] -> Ctx a
loop [] =
        Environment a -> Types a -> Ctx a
forall a. Environment a -> Types a -> Ctx a
Ctx Environment a
forall a. Environment a
Empty Types a
forall a. Types a
TypesEmpty

    loop ((Text
x, Expr s a
t):[(Text, Expr s a)]
rest) =
        Environment a -> Types a -> Ctx a
forall a. Environment a -> Types a -> Ctx a
Ctx (Environment a -> Text -> Environment a
forall a. Environment a -> Text -> Environment a
Skip Environment a
vs Text
x) (Types a -> Text -> Val a -> Types a
forall a. Types a -> Text -> Val a -> Types a
TypesBind Types a
ts Text
x (Environment a -> Expr X a -> Val a
forall a. Eq a => Environment a -> Expr X a -> Val a
Eval.eval Environment a
vs (Expr s a -> Expr X a
forall s a t. Expr s a -> Expr t a
Dhall.Core.denote Expr s a
t)))
      where
        Ctx Environment a
vs Types a
ts = [(Text, Expr s a)] -> Ctx a
loop [(Text, Expr s a)]
rest

ctxToContext :: Eq a => Ctx a -> Context (Expr s a)
ctxToContext :: Ctx a -> Context (Expr s a)
ctxToContext (Ctx {Environment a
Types a
types :: forall a. Ctx a -> Types a
values :: forall a. Ctx a -> Environment a
types :: Types a
values :: Environment a
..}) = Types a -> Context (Expr s a)
forall a s. Eq a => Types a -> Context (Expr s a)
loop Types a
types
  where
    loop :: Types a -> Context (Expr s a)
loop (TypesBind Types a
ts Text
x Val a
t) = Text -> Expr s a -> Context (Expr s a) -> Context (Expr s a)
forall a. Text -> a -> Context a -> Context a
Dhall.Context.insert Text
x Expr s a
forall s. Expr s a
t' (Types a -> Context (Expr s a)
loop Types a
ts)
      where
        ns :: Names
ns = Types a -> Names
forall a. Types a -> Names
typesToNames Types a
ts

        t' :: Expr s a
t' = Expr X a -> Expr s a
forall a s. Expr X a -> Expr s a
Dhall.Core.renote (Names -> Val a -> Expr X a
forall a. Eq a => Names -> Val a -> Expr X a
Eval.quote Names
ns Val a
t)
    loop Types a
TypesEmpty = Context (Expr s a)
forall a. Context a
Dhall.Context.empty

typesToNames :: Types a -> Names
typesToNames :: Types a -> Names
typesToNames (TypesBind Types a
ts Text
x Val a
_) = Names -> Text -> Names
Bind Names
ns Text
x
  where
    ns :: Names
ns = Types a -> Names
forall a. Types a -> Names
typesToNames Types a
ts
typesToNames Types a
TypesEmpty = Names
EmptyNames

data Types a = TypesEmpty | TypesBind !(Types a) {-# UNPACK #-} !Text (Val a)

data Ctx a = Ctx { Ctx a -> Environment a
values :: !(Environment a), Ctx a -> Types a
types :: !(Types a) }

addType :: Text -> Val a -> Ctx a -> Ctx a
addType :: Text -> Val a -> Ctx a -> Ctx a
addType Text
x Val a
t (Ctx Environment a
vs Types a
ts) = Environment a -> Types a -> Ctx a
forall a. Environment a -> Types a -> Ctx a
Ctx (Environment a -> Text -> Environment a
forall a. Environment a -> Text -> Environment a
Skip Environment a
vs Text
x) (Types a -> Text -> Val a -> Types a
forall a. Types a -> Text -> Val a -> Types a
TypesBind Types a
ts Text
x Val a
t)

addTypeValue :: Text -> Val a -> Val a -> Ctx a -> Ctx a
addTypeValue :: Text -> Val a -> Val a -> Ctx a -> Ctx a
addTypeValue Text
x Val a
t Val a
v (Ctx Environment a
vs Types a
ts) = Environment a -> Types a -> Ctx a
forall a. Environment a -> Types a -> Ctx a
Ctx (Environment a -> Text -> Val a -> Environment a
forall a. Environment a -> Text -> Val a -> Environment a
Extend Environment a
vs Text
x Val a
v) (Types a -> Text -> Val a -> Types a
forall a. Types a -> Text -> Val a -> Types a
TypesBind Types a
ts Text
x Val a
t)

fresh :: Ctx a -> Text -> Val a
fresh :: Ctx a -> Text -> Val a
fresh Ctx{Environment a
Types a
types :: Types a
values :: Environment a
types :: forall a. Ctx a -> Types a
values :: forall a. Ctx a -> Environment a
..} Text
x = Text -> Int -> Val a
forall a. Text -> Int -> Val a
VVar Text
x (Text -> Names -> Int
Eval.countNames Text
x (Environment a -> Names
forall a. Environment a -> Names
Eval.envNames Environment a
values))

{-| `typeWithA` is implemented internally in terms of @infer@ in order to speed
    up equivalence checking.

    Specifically, we extend the `Context` to become a @Ctx@, which can store
    the entire contents of a `let` expression (i.e. the type *and* the value
    of the bound variable).  By storing this extra information in the @Ctx@ we
    no longer need to substitute `let` expressions at all (which is very
    expensive!).

    However, this means that we need to use `Dhall.Eval.conv` to perform
    equivalence checking instead of `Dhall.Core.judgmentallyEqual` since
    only `Dhall.Core.judgmentallyEqual` is unable to use the information stored
    in the extended context for accurate equivalence checking.
-}
infer
    :: forall a s
    .  (Eq a, Pretty a)
    => Typer a
    -> Ctx a
    -> Expr s a
    -> Either (TypeError s a) (Val a)
infer :: Typer a -> Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
infer Typer a
typer = Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop
  where
    {- The convention for primes (i.e. `'`s) is:

       * No primes  (`x`  ): An `Expr` that has not been `eval`ed yet
       * One prime  (`x'` ): A  `Val`
       * Two primes (`x''`): An `Expr` generated from `quote`ing a `Val`
    -}
    loop :: Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
    loop :: Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop ctx :: Ctx a
ctx@Ctx{Environment a
Types a
types :: Types a
values :: Environment a
types :: forall a. Ctx a -> Types a
values :: forall a. Ctx a -> Environment a
..} Expr s a
expression = case Expr s a
expression of
        Const Const
c ->
            (Const -> Val a)
-> Either (TypeError s a) Const -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Const -> Val a
forall a. Const -> Val a
VConst (Const -> Either (TypeError s a) Const
forall s a. Const -> Either (TypeError s a) Const
axiom Const
c)

        Var (V Text
x0 Int
n0) -> do
            let go :: Types a -> t -> Either (TypeError s a) (Val a)
go Types a
TypesEmpty t
_ =
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> TypeMessage s a
forall s a. Text -> TypeMessage s a
UnboundVariable Text
x0)
                go (TypesBind Types a
ts Text
x Val a
t) t
n
                    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x0   = if t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
t else Types a -> t -> Either (TypeError s a) (Val a)
go Types a
ts (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
                    | Bool
otherwise = Types a -> t -> Either (TypeError s a) (Val a)
go Types a
ts t
n

            Types a -> Int -> Either (TypeError s a) (Val a)
forall t a.
(Eq t, Num t) =>
Types a -> t -> Either (TypeError s a) (Val a)
go Types a
types Int
n0

        Lam Maybe CharacterSet
_ (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s a
_A}) Expr s a
b -> do
            Val a
tA' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_A

            case Val a
tA' of
                VConst Const
_ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidInputType Expr s a
_A)

            let _A' :: Val a
_A' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_A

            let ctx' :: Ctx a
ctx' = Text -> Val a -> Ctx a -> Ctx a
forall a. Text -> Val a -> Ctx a -> Ctx a
addType Text
x Val a
_A' Ctx a
ctx

            Val a
_B' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx' Expr s a
b

            let _B'' :: Expr s a
_B'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote (Names -> Text -> Names
Bind (Environment a -> Names
forall a. Environment a -> Names
Eval.envNames Environment a
values) Text
x) Val a
_B'

            Val a
tB' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx' (Expr X a -> Expr s a
forall a s. Expr X a -> Expr s a
Dhall.Core.renote Expr X a
forall s. Expr s a
_B'')

            case Val a
tB' of
                VConst Const
_ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidOutputType Expr s a
forall s. Expr s a
_B'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
x Val a
_A' (\Val a
u -> Environment a -> Expr X a -> Val a
forall a. Eq a => Environment a -> Expr X a -> Val a
Eval.eval (Environment a -> Text -> Val a -> Environment a
forall a. Environment a -> Text -> Val a -> Environment a
Extend Environment a
values Text
x Val a
u) Expr X a
forall s. Expr s a
_B''))

        Pi Maybe CharacterSet
_ Text
x Expr s a
_A Expr s a
_B -> do
            Val a
tA' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_A

            Const
kA <- case Val a
tA' of
                VConst Const
kA -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
kA
                Val a
_         -> TypeMessage s a -> Either (TypeError s a) Const
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidInputType Expr s a
_A)

            let _A' :: Val a
_A' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_A

            let ctx' :: Ctx a
ctx' = Text -> Val a -> Ctx a -> Ctx a
forall a. Text -> Val a -> Ctx a -> Ctx a
addType Text
x Val a
_A' Ctx a
ctx

            Val a
tB' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx' Expr s a
_B

            Const
kB <- case Val a
tB' of
                VConst Const
kB -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
kB
                Val a
_         -> TypeMessage s a -> Either (TypeError s a) Const
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidOutputType Expr s a
_B)

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst (Const -> Const -> Const
rule Const
kA Const
kB))

        App Expr s a
f Expr s a
a -> do
            Val a
tf' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
f

            case Val a -> Maybe (Text, Val a, Val a -> Val a)
forall a. Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a)
Eval.toVHPi Val a
tf' of
                Just (Text
_x, Val a
_A₀', Val a -> Val a
_B') -> do
                    Val a
_A₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
a

                    if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_A₀' Val a
_A₁'
                        then do
                            let a' :: Val a
a' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
a

                            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
_B' Val a
a')

                        else do
                            let _A₀'' :: Expr s a
_A₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₀'
                            let _A₁'' :: Expr s a
_A₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₁'
                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
TypeMismatch Expr s a
f Expr s a
forall s. Expr s a
_A₀'' Expr s a
a Expr s a
forall s. Expr s a
_A₁'')
                Maybe (Text, Val a, Val a -> Val a)
Nothing ->
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
NotAFunction Expr s a
f (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tf'))

        Let (Binding { value :: forall s a. Binding s a -> Expr s a
value = Expr s a
a₀, variable :: forall s a. Binding s a -> Text
variable = Text
x, Maybe s
Maybe (Maybe s, Expr s a)
bindingSrc2 :: forall s a. Binding s a -> Maybe s
annotation :: forall s a. Binding s a -> Maybe (Maybe s, Expr s a)
bindingSrc1 :: forall s a. Binding s a -> Maybe s
bindingSrc0 :: forall s a. Binding s a -> Maybe s
bindingSrc2 :: Maybe s
annotation :: Maybe (Maybe s, Expr s a)
bindingSrc1 :: Maybe s
bindingSrc0 :: Maybe s
..}) Expr s a
body -> do
            let a₀' :: Val a
a₀' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
a₀

            Ctx a
ctxNew <- case Maybe (Maybe s, Expr s a)
annotation of
                Maybe (Maybe s, Expr s a)
Nothing -> do
                    Val a
_A' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
a₀

                    Ctx a -> Either (TypeError s a) (Ctx a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> Val a -> Ctx a -> Ctx a
forall a. Text -> Val a -> Val a -> Ctx a -> Ctx a
addTypeValue Text
x Val a
_A' Val a
a₀' Ctx a
ctx)
                Just (Maybe s
_, Expr s a
_A₀) -> do
                    Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_A₀

                    let _A₀' :: Val a
_A₀' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_A₀

                    Val a
_A₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
a₀

                    if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_A₀' Val a
_A₁'
                        then
                            () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                        else do
                            let _A₀'' :: Expr s a
_A₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₀'
                            let _A₁'' :: Expr s a
_A₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₁'
                            TypeError s a -> Either (TypeError s a) ()
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
forall s. Context (Expr s a)
context Expr s a
a₀ (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
AnnotMismatch Expr s a
a₀ Expr s a
forall s. Expr s a
_A₀'' Expr s a
forall s. Expr s a
_A₁''))

                    Ctx a -> Either (TypeError s a) (Ctx a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> Val a -> Ctx a -> Ctx a
forall a. Text -> Val a -> Val a -> Ctx a -> Ctx a
addTypeValue Text
x Val a
_A₀' Val a
a₀' Ctx a
ctx)

            Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctxNew Expr s a
body

        Annot Expr s a
t Expr s a
_T₀ -> do
            case Expr s a -> Expr Any a
forall s a t. Expr s a -> Expr t a
Dhall.Core.denote Expr s a
_T₀ of
                Const Const
_ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Expr Any a
_       -> do
                    Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T₀

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

            let _T₀' :: Val a
_T₀' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_T₀

            Val a
_T₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
t

            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_T₀' Val a
_T₁'
                then
                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₁'

                else do
                    let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'
                    let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
AnnotMismatch Expr s a
t Expr s a
forall s. Expr s a
_T₀'' Expr s a
forall s. Expr s a
_T₁'')

        Expr s a
Bool ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        BoolLit Bool
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VBool

        BoolAnd Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAnd Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAnd Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VBool

        BoolOr Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantOr Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantOr Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VBool

        BoolEQ Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantEQ Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantEQ Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VBool

        BoolNE Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantNE Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantNE Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VBool

        BoolIf Expr s a
t Expr s a
l Expr s a
r -> do
            Val a
tt' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
t

            case Val a
tt' of
                Val a
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
InvalidPredicate Expr s a
t (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tt'))

            Val a
_L' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            Val a
_R' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_L')

            let _L'' :: Expr s a
_L'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_L'

            Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_R')

            let _R'' :: Expr s a
_R'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_R'

            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_L' Val a
_R'
                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
IfBranchMismatch Expr s a
l Expr s a
r Expr s a
forall s. Expr s a
_L'' Expr s a
forall s. Expr s a
_R'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_L'

        Expr s a
Natural ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        NaturalLit Natural
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VNatural

        Expr s a
NaturalFold ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Val a
forall a. Val a
VNatural
                Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~>  Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"natural" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
natural ->
                        Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"succ" (Val a
natural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
natural) (\Val a
_succ ->
                            Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"zero" Val a
natural (\Val a
_zero ->
                                Val a
natural
                            )
                        )
                    )
                )

        Expr s a
NaturalBuild ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"natural" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
natural ->
                        Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"succ" (Val a
natural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
natural) (\Val a
_succ ->
                            Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"zero" Val a
natural (\Val a
_zero ->
                                Val a
natural
                            )
                        )
                    )
                Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~>  Val a
forall a. Val a
VNatural
                )

        Expr s a
NaturalIsZero ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VBool)

        Expr s a
NaturalEven ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VBool)

        Expr s a
NaturalOdd ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VBool)

        Expr s a
NaturalToInteger ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VInteger)

        Expr s a
NaturalShow ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VText)

        Expr s a
NaturalSubtract ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VNatural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VNatural)

        NaturalPlus Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAdd Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAdd Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VNatural

        NaturalTimes Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantMultiply Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_        -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantMultiply Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VNatural

        Expr s a
Integer ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        IntegerLit Integer
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VInteger

        Expr s a
IntegerClamp ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VInteger Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VNatural)

        Expr s a
IntegerNegate ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VInteger Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VInteger)

        Expr s a
IntegerShow ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VInteger Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VText)

        Expr s a
IntegerToDouble ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VInteger Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VDouble)

        Expr s a
Double ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        DoubleLit DhallDouble
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VDouble

        Expr s a
DoubleShow ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VDouble Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VText)

        Expr s a
Text ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        TextLit (Chunks [(Text, Expr s a)]
xys Text
_) -> do
            let process :: (a, Expr s a) -> Either (TypeError s a) ()
process (a
_, Expr s a
y) = do
                    Val a
_Y' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
y

                    case Val a
_Y' of
                        Val a
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantInterpolate Expr s a
y (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_Y'))

            ((Text, Expr s a) -> Either (TypeError s a) ())
-> [(Text, Expr s a)] -> Either (TypeError s a) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, Expr s a) -> Either (TypeError s a) ()
forall a. (a, Expr s a) -> Either (TypeError s a) ()
process [(Text, Expr s a)]
xys

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VText

        TextAppend Expr s a
l Expr s a
r -> do
            Val a
tl' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
tl' of
                Val a
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantTextAppend Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tl'))

            Val a
tr' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            case Val a
tr' of
                Val a
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_     -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantTextAppend Expr s a
r (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tr'))

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VText

        Expr s a
TextReplace ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"needle" Val a
forall a. Val a
VText  (\Val a
_needle ->
                        Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"replacement" Val a
forall a. Val a
VText (\Val a
_replacement ->
                            Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"haystack" Val a
forall a. Val a
VText (\Val a
_haystack ->
                                Val a
forall a. Val a
VText
                            )
                        )
                    )
                )
        Expr s a
TextShow ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a
forall a. Val a
VText Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VText)

        Expr s a
Date ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        DateLiteral Day
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VDate

        Expr s a
Time ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        TimeLiteral TimeOfDay
_ Word
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VTime

        Expr s a
TimeZone ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        TimeZoneLiteral TimeZone
_ ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VTimeZone

        Expr s a
List ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        ListLit Maybe (Expr s a)
Nothing Seq (Expr s a)
ts₀ ->
            case Seq (Expr s a) -> ViewL (Expr s a)
forall a. Seq a -> ViewL a
Data.Sequence.viewl Seq (Expr s a)
ts₀ of
                Expr s a
t₀ :< Seq (Expr s a)
ts₁ -> do
                    Val a
_T₀' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
t₀

                    let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'

                    Val a
tT₀' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
forall s. Expr s a
_T₀''

                    case Val a
tT₀' of
                        VConst Const
Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Val a
_           -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidListType (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
forall s a. Expr s a
List Expr s a
forall s. Expr s a
_T₀''))

                    let process :: Int -> Expr s a -> Either (TypeError s a) ()
process Int
i Expr s a
t₁ = do
                            Val a
_T₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
t₁

                            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_T₀' Val a
_T₁'
                                then
                                    () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                                else do
                                    let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'
                                    let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'

                                    -- Carefully note that we don't use `die`
                                    -- here so that the source span is narrowed
                                    -- to just the offending element
                                    let err :: TypeMessage s a
err = Int -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Int -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
MismatchedListElements (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Expr s a
forall s. Expr s a
_T₀'' Expr s a
t₁ Expr s a
forall s. Expr s a
_T₁''

                                    TypeError s a -> Either (TypeError s a) ()
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
forall s. Context (Expr s a)
context Expr s a
t₁ TypeMessage s a
err)

                    (Int -> Expr s a -> Either (TypeError s a) ())
-> Seq (Expr s a) -> Either (TypeError s a) ()
forall i (t :: * -> *) (f :: * -> *) a b.
(FoldableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f ()
Foldable.WithIndex.itraverse_ Int -> Expr s a -> Either (TypeError s a) ()
process Seq (Expr s a)
ts₁

                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
forall a. Val a -> Val a
VList Val a
_T₀')

                ViewL (Expr s a)
_ ->
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
MissingListType

        ListLit (Just Expr s a
_T₀) Seq (Expr s a)
ts ->
            if Seq (Expr s a) -> Bool
forall a. Seq a -> Bool
Data.Sequence.null Seq (Expr s a)
ts
                then do
                    Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T₀

                    let _T₀' :: Val a
_T₀' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_T₀

                    let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'

                    case Val a
_T₀' of
                        VList Val a
_ -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'
                        Val a
_       -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidListType Expr s a
forall s. Expr s a
_T₀'')

                -- See https://github.com/dhall-lang/dhall-haskell/issues/1359.
                else TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
ListLitInvariant

        ListAppend Expr s a
x Expr s a
y -> do
            Val a
tx' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
x

            Val a
_A₀' <- case Val a
tx' of
                VList Val a
_A₀' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_A₀'
                Val a
_          -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantListAppend Expr s a
x (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tx'))

            Val a
ty' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
y

            Val a
_A₁' <- case Val a
ty' of
                VList Val a
_A₁' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_A₁'
                Val a
_          -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantListAppend Expr s a
y (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
ty'))

            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_A₀' Val a
_A₁'
                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else do
                    let _A₀'' :: Expr s a
_A₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₀'
                    let _A₁'' :: Expr s a
_A₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₁'
                    TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
ListAppendMismatch Expr s a
forall s. Expr s a
_A₀'' Expr s a
forall s. Expr s a
_A₁'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
forall a. Val a -> Val a
VList Val a
_A₀')

        Expr s a
ListBuild ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a ->
                            Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"list" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
list ->
                                Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"cons" (Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
list Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
list) (\Val a
_cons ->
                                    (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"nil" Val a
list (\Val a
_nil -> Val a
list))
                                )
                            )
                        Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~>  Val a -> Val a
forall a. Val a -> Val a
VList Val a
a
                    )
                )

        Expr s a
ListFold ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a ->
                            Val a -> Val a
forall a. Val a -> Val a
VList Val a
a
                        Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~>  Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"list" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
list ->
                                Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"cons" (Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
list Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
list) (\Val a
_cons ->
                                    (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"nil" Val a
list (\Val a
_nil -> Val a
list))
                                )
                            )
                    )
                )

        Expr s a
ListLength ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a -> Val a -> Val a
forall a. Val a -> Val a
VList Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
forall a. Val a
VNatural))

        Expr s a
ListHead ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a -> Val a -> Val a
forall a. Val a -> Val a
VList Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
a))

        Expr s a
ListLast ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a -> Val a -> Val a
forall a. Val a -> Val a
VList Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
a))

        Expr s a
ListIndexed ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (   Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a ->
                            Val a -> Val a
forall a. Val a -> Val a
VList Val a
a
                        Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~>  Val a -> Val a
forall a. Val a -> Val a
VList
                                (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord
                                    ([(Text, Val a)] -> Map Text (Val a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.unorderedFromList
                                        [ (Text
"index", Val a
forall a. Val a
VNatural)
                                        , (Text
"value", Val a
a       )
                                        ]
                                    )
                                )
                    )
                )
        Expr s a
ListReverse ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
a -> Val a -> Val a
forall a. Val a -> Val a
VList Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a -> Val a
forall a. Val a -> Val a
VList Val a
a))

        Expr s a
Optional ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        Expr s a
None ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"A" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\Val a
_A -> Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
_A))

        Some Expr s a
a -> do
            Val a
_A' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
a

            Val a
tA' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A')

            case Val a
tA' of
                VConst Const
Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_           -> do
                   let _A'' :: Expr s a
_A'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A'
                   let tA'' :: Expr s a
tA'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tA'

                   TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
InvalidSome Expr s a
a Expr s a
forall s. Expr s a
_A'' Expr s a
forall s. Expr s a
tA'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
_A')

        Record Map Text (RecordField s a)
xTs -> do
            let process :: Text
-> RecordField s a
-> WriterT (Max Const) (Either (TypeError s a)) ()
process Text
x (RecordField {recordFieldValue :: forall s a. RecordField s a -> Expr s a
recordFieldValue = Expr s a
_T}) = do
                    Val a
tT' <- Either (TypeError s a) (Val a)
-> WriterT (Max Const) (Either (TypeError s a)) (Val a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T)

                    case Val a
tT' of
                        VConst Const
c -> Max Const -> WriterT (Max Const) (Either (TypeError s a)) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Const -> Max Const
forall a. a -> Max a
Max Const
c)
                        Val a
_        -> Either (TypeError s a) ()
-> WriterT (Max Const) (Either (TypeError s a)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidFieldType Text
x Expr s a
_T))

            Max Const
c <- WriterT (Max Const) (Either (TypeError s a)) ()
-> Either (TypeError s a) (Max Const)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT ((Text
 -> RecordField s a
 -> WriterT (Max Const) (Either (TypeError s a)) ())
-> Map Text (RecordField s a)
-> WriterT (Max Const) (Either (TypeError s a)) ()
forall k (f :: * -> *) a.
(Ord k, Applicative f) =>
(k -> a -> f ()) -> Map k a -> f ()
Dhall.Map.unorderedTraverseWithKey_ Text
-> RecordField s a
-> WriterT (Max Const) (Either (TypeError s a)) ()
process Map Text (RecordField s a)
xTs)

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
c)

        RecordLit Map Text (RecordField s a)
xts -> do
            let process :: RecordField s a -> Either (TypeError s a) (Val a)
process RecordField s a
t = do
                    Val a
_T' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Expr s a -> Either (TypeError s a) (Val a))
-> Expr s a -> Either (TypeError s a) (Val a)
forall a b. (a -> b) -> a -> b
$ RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue RecordField s a
t

                    let _T'' :: Expr s a
_T'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T'

                    Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
forall s. Expr s a
_T''

                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T'

            Map Text (Val a)
xTs <- (RecordField s a -> Either (TypeError s a) (Val a))
-> Map Text (RecordField s a)
-> Either (TypeError s a) (Map Text (Val a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse RecordField s a -> Either (TypeError s a) (Val a)
process (Map Text (RecordField s a) -> Map Text (RecordField s a)
forall k v. Map k v -> Map k v
Dhall.Map.sort Map Text (RecordField s a)
xts)

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord Map Text (Val a)
xTs)

        Union Map Text (Maybe (Expr s a))
xTs -> do
            let process :: Text -> Maybe (Expr s a) -> Either (TypeError s a) (Max Const)
process Text
_ Maybe (Expr s a)
Nothing =
                    Max Const -> Either (TypeError s a) (Max Const)
forall (m :: * -> *) a. Monad m => a -> m a
return Max Const
forall a. Monoid a => a
mempty

                process Text
x₁ (Just Expr s a
_T₁) = do
                    Val a
tT₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T₁

                    case Val a
tT₁' of
                        VConst Const
c -> Max Const -> Either (TypeError s a) (Max Const)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Max Const
forall a. a -> Max a
Max Const
c)
                        Val a
_        -> TypeMessage s a -> Either (TypeError s a) (Max Const)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidAlternativeType Text
x₁ Expr s a
_T₁)

            Max Const
c <- (Map Text (Max Const) -> Max Const)
-> Either (TypeError s a) (Map Text (Max Const))
-> Either (TypeError s a) (Max Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Text (Max Const) -> Max Const
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold ((Text -> Maybe (Expr s a) -> Either (TypeError s a) (Max Const))
-> Map Text (Maybe (Expr s a))
-> Either (TypeError s a) (Map Text (Max Const))
forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> Map k a -> f (Map k b)
Dhall.Map.unorderedTraverseWithKey Text -> Maybe (Expr s a) -> Either (TypeError s a) (Max Const)
process Map Text (Maybe (Expr s a))
xTs)
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
c)
        Combine Maybe CharacterSet
_ Maybe Text
mk Expr s a
l Expr s a
r -> do
            Val a
_L' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            let l'' :: Expr s a
l'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
l)

            Val a
_R' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            let r'' :: Expr s a
r'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
r)

            Map Text (Val a)
xLs' <- case Val a
_L' of
                VRecord Map Text (Val a)
xLs' ->
                    Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xLs'

                Val a
_ -> do
                    let _L'' :: Expr s a
_L'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_L'

                    case Maybe Text
mk of
                        Maybe Text
Nothing -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Char -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Char -> Expr s a -> Expr s a -> TypeMessage s a
MustCombineARecord Char
'∧' Expr s a
forall s. Expr s a
l'' Expr s a
forall s. Expr s a
_L'')
                        Just Text
t  -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
InvalidDuplicateField Text
t Expr s a
l Expr s a
forall s. Expr s a
_L'')

            Map Text (Val a)
xRs' <- case Val a
_R' of
                VRecord Map Text (Val a)
xRs' ->
                    Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xRs'

                Val a
_ -> do
                    let _R'' :: Expr s a
_R'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_R'

                    case Maybe Text
mk of
                        Maybe Text
Nothing -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Char -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Char -> Expr s a -> Expr s a -> TypeMessage s a
MustCombineARecord Char
'∧' Expr s a
forall s. Expr s a
r'' Expr s a
forall s. Expr s a
_R'')
                        Just Text
t  -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
InvalidDuplicateField Text
t Expr s a
r Expr s a
forall s. Expr s a
_R'')

            let combineTypes :: [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) (Val a)
combineTypes [Text]
xs Map Text (Val a)
xLs₀' Map Text (Val a)
xRs₀' = do
                    let combine :: Text -> Val a -> Val a -> Either (TypeError s a) (Val a)
combine Text
x (VRecord Map Text (Val a)
xLs₁') (VRecord Map Text (Val a)
xRs₁') =
                            [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) (Val a)
combineTypes (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs) Map Text (Val a)
xLs₁' Map Text (Val a)
xRs₁'

                        combine Text
x Val a
_ Val a
_ =
                            case Maybe Text
mk of
                                Maybe Text
Nothing -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (NonEmpty Text -> TypeMessage s a
forall s a. NonEmpty Text -> TypeMessage s a
FieldCollision (NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (Text
x Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
xs)))
                                Just Text
t  -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (NonEmpty Text -> TypeMessage s a
forall s a. NonEmpty Text -> TypeMessage s a
DuplicateFieldCannotBeMerged (Text
t Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)))

                    let xEs :: Map Text (Either (TypeError s a) (Val a))
xEs =
                            (Val a -> Either (TypeError s a) (Val a))
-> (Val a -> Either (TypeError s a) (Val a))
-> (Text -> Val a -> Val a -> Either (TypeError s a) (Val a))
-> Map Text (Val a)
-> Map Text (Val a)
-> Map Text (Either (TypeError s a) (Val a))
forall k a c b.
Ord k =>
(a -> c)
-> (b -> c) -> (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Dhall.Map.outerJoin Val a -> Either (TypeError s a) (Val a)
forall a b. b -> Either a b
Right Val a -> Either (TypeError s a) (Val a)
forall a b. b -> Either a b
Right Text -> Val a -> Val a -> Either (TypeError s a) (Val a)
combine Map Text (Val a)
xLs₀' Map Text (Val a)
xRs₀'

                    Map Text (Val a)
xTs <- (Text
 -> Either (TypeError s a) (Val a)
 -> Either (TypeError s a) (Val a))
-> Map Text (Either (TypeError s a) (Val a))
-> Either (TypeError s a) (Map Text (Val a))
forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> Map k a -> f (Map k b)
Dhall.Map.unorderedTraverseWithKey (\Text
_x Either (TypeError s a) (Val a)
_E -> Either (TypeError s a) (Val a)
_E) Map Text (Either (TypeError s a) (Val a))
xEs

                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord Map Text (Val a)
xTs)

            [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) (Val a)
forall a.
[Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) (Val a)
combineTypes [] Map Text (Val a)
xLs' Map Text (Val a)
xRs'

        CombineTypes Maybe CharacterSet
_ Expr s a
l Expr s a
r -> do
            Val a
_L' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            let l' :: Val a
l' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
l

            let l'' :: Expr s a
l'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
l'

            Const
cL <- case Val a
_L' of
                VConst Const
cL -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
cL
                Val a
_         -> TypeMessage s a -> Either (TypeError s a) Const
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CombineTypesRequiresRecordType Expr s a
l Expr s a
forall s. Expr s a
l'')

            Val a
_R' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            let r' :: Val a
r' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
r

            let r'' :: Expr s a
r'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
r'

            Const
cR <- case Val a
_R' of
                VConst Const
cR -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
cR
                Val a
_         -> TypeMessage s a -> Either (TypeError s a) Const
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CombineTypesRequiresRecordType Expr s a
r Expr s a
forall s. Expr s a
r'')

            let c :: Const
c = Const -> Const -> Const
forall a. Ord a => a -> a -> a
max Const
cL Const
cR

            Map Text (Val a)
xLs' <- case Val a
l' of
                VRecord Map Text (Val a)
xLs' -> Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xLs'
                Val a
_            -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CombineTypesRequiresRecordType Expr s a
l Expr s a
forall s. Expr s a
l'')

            Map Text (Val a)
xRs' <- case Val a
r' of
                VRecord Map Text (Val a)
xRs' -> Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xRs'
                Val a
_            -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CombineTypesRequiresRecordType Expr s a
r Expr s a
forall s. Expr s a
r'')

            let combineTypes :: [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) ()
combineTypes [Text]
xs Map Text (Val a)
xLs₀' Map Text (Val a)
xRs₀' = do
                    let combine :: Text -> Val a -> Val a -> Either (TypeError s a) ()
combine Text
x (VRecord Map Text (Val a)
xLs₁') (VRecord Map Text (Val a)
xRs₁') =
                            [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) ()
combineTypes (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs) Map Text (Val a)
xLs₁' Map Text (Val a)
xRs₁'

                        combine Text
x Val a
_ Val a
_ =
                            TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (NonEmpty Text -> TypeMessage s a
forall s a. NonEmpty Text -> TypeMessage s a
FieldTypeCollision (NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (Text
x Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
xs)))

                    let mL :: Map Text (Val a)
mL = Map Text (Val a) -> Map Text (Val a)
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text (Val a)
xLs₀'
                    let mR :: Map Text (Val a)
mR = Map Text (Val a) -> Map Text (Val a)
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text (Val a)
xRs₀'

                    Map Text (Either (TypeError s a) ()) -> Either (TypeError s a) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
Foldable.sequence_ ((Text -> Val a -> Val a -> Either (TypeError s a) ())
-> Map Text (Val a)
-> Map Text (Val a)
-> Map Text (Either (TypeError s a) ())
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Data.Map.intersectionWithKey Text -> Val a -> Val a -> Either (TypeError s a) ()
combine Map Text (Val a)
mL Map Text (Val a)
mR)

            [Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) ()
forall a a.
[Text]
-> Map Text (Val a)
-> Map Text (Val a)
-> Either (TypeError s a) ()
combineTypes [] Map Text (Val a)
xLs' Map Text (Val a)
xRs'

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
c)

        Prefer Maybe CharacterSet
_ PreferAnnotation s a
a Expr s a
l Expr s a
r -> do
            Val a
_L' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            Val a
_R' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
r

            Map Text (Val a)
xLs' <- case Val a
_L' of
                VRecord Map Text (Val a)
xLs' -> Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xLs'

                Val a
_            -> do
                    let _L'' :: Expr s a
_L'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_L'

                    let l'' :: Expr s a
l'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
l)

                    case PreferAnnotation s a
a of
                        PreferFromWith Expr s a
withExpression ->
                            TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
MustUpdateARecord Expr s a
withExpression Expr s a
forall s. Expr s a
l'' Expr s a
forall s. Expr s a
_L'')
                        PreferAnnotation s a
_ ->
                            TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Char -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Char -> Expr s a -> Expr s a -> TypeMessage s a
MustCombineARecord Char
'⫽' Expr s a
forall s. Expr s a
l'' Expr s a
forall s. Expr s a
_L'')

            Map Text (Val a)
xRs' <- case Val a
_R' of
                VRecord Map Text (Val a)
xRs' -> Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xRs'

                Val a
_            -> do
                    let _R'' :: Expr s a
_R'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_R'

                    let r'' :: Expr s a
r'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
r)

                    TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Char -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Char -> Expr s a -> Expr s a -> TypeMessage s a
MustCombineARecord Char
'⫽' Expr s a
forall s. Expr s a
r'' Expr s a
forall s. Expr s a
_R'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord (Map Text (Val a) -> Map Text (Val a) -> Map Text (Val a)
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (Val a)
xRs' Map Text (Val a)
xLs'))

        RecordCompletion Expr s a
l Expr s a
r -> do
            Val a
_L' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

            case Val a
_L' of
                VRecord Map Text (Val a)
xLs'
                  | Bool -> Bool
not (Text -> Map Text (Val a) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
"default" Map Text (Val a)
xLs')
                     -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidRecordCompletion Text
"default" Expr s a
l)
                  | Bool -> Bool
not (Text -> Map Text (Val a) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
"Type" Map Text (Val a)
xLs')
                     -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidRecordCompletion Text
"Type" Expr s a
l)
                  | Bool
otherwise
                     -> Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
Annot (Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Monoid a => a
mempty PreferAnnotation s a
forall s a. PreferAnnotation s a
PreferFromCompletion (Expr s a -> FieldSelection s -> Expr s a
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s a
l FieldSelection s
forall s. FieldSelection s
def) Expr s a
r) (Expr s a -> FieldSelection s -> Expr s a
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s a
l FieldSelection s
forall s. FieldSelection s
typ))
                Val a
_ -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CompletionSchemaMustBeARecord Expr s a
l (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_L'))

              where
                def :: FieldSelection s
def = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
"default"
                typ :: FieldSelection s
typ = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
"Type"
        Merge Expr s a
t Expr s a
u Maybe (Expr s a)
mT₁ -> do
            Val a
_T' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
t

            Map Text (Val a)
yTs' <- case Val a
_T' of
                VRecord Map Text (Val a)
yTs' ->
                    Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
yTs'

                Val a
_ -> do
                    let _T'' :: Expr s a
_T'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T'

                    TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMergeARecord Expr s a
t Expr s a
forall s. Expr s a
_T'')

            Val a
_U' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
u

            Map Text (Maybe (Val a))
yUs' <- case Val a
_U' of
                VUnion Map Text (Maybe (Val a))
yUs' ->
                    Map Text (Maybe (Val a))
-> Either (TypeError s a) (Map Text (Maybe (Val a)))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Maybe (Val a))
yUs'

                VOptional Val a
_O' ->
                    -- This is a bit of hack, but it allows us to reuse the
                    -- rather complex type-matching logic for Optionals.
                    Map Text (Maybe (Val a))
-> Either (TypeError s a) (Map Text (Maybe (Val a)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Maybe (Val a))] -> Map Text (Maybe (Val a))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.unorderedFromList [(Text
"None", Maybe (Val a)
forall a. Maybe a
Nothing), (Text
"Some", Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just Val a
_O')])

                Val a
_ -> do
                    let _U'' :: Expr s a
_U'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_U'

                    TypeMessage s a
-> Either (TypeError s a) (Map Text (Maybe (Val a)))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMergeUnionOrOptional Expr s a
u Expr s a
forall s. Expr s a
_U'')

            let ysT :: Set Text
ysT = Map Text (Val a) -> Set Text
forall k v. Map k v -> Set k
Dhall.Map.keysSet Map Text (Val a)
yTs'
            let ysU :: Set Text
ysU = Map Text (Maybe (Val a)) -> Set Text
forall k v. Map k v -> Set k
Dhall.Map.keysSet Map Text (Maybe (Val a))
yUs'

            let diffT :: Set Text
diffT = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
ysT Set Text
ysU
            let diffU :: Set Text
diffU = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
ysU Set Text
ysT

            if Set Text -> Bool
forall a. Set a -> Bool
Data.Set.null Set Text
diffT
                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Set Text -> TypeMessage s a
forall s a. Set Text -> TypeMessage s a
UnusedHandler Set Text
diffT)

            if Set Text -> Bool
forall a. Set a -> Bool
Data.Set.null Set Text
diffU
                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else let (Text
exemplar,Set Text
rest) = Set Text -> (Text, Set Text)
forall a. Set a -> (a, Set a)
Data.Set.deleteFindMin Set Text
diffU
                     in TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Set Text -> TypeMessage s a
forall s a. Text -> Set Text -> TypeMessage s a
MissingHandler Text
exemplar Set Text
rest)

            let match :: Text -> Val a -> Maybe (Val a) -> Either (TypeError s a) (Val a)
match Text
_y Val a
_T₀' Maybe (Val a)
Nothing =
                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'

                match Text
y Val a
handler' (Just Val a
_A₁') =
                    case Val a -> Maybe (Text, Val a, Val a -> Val a)
forall a. Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a)
Eval.toVHPi Val a
handler' of
                        Just (Text
x, Val a
_A₀', Val a -> Val a
_T₀') ->
                            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_A₀' Val a
_A₁'
                                then do
                                    let _T₁' :: Val a
_T₁' = Val a -> Val a
_T₀' (Ctx a -> Text -> Val a
forall a. Ctx a -> Text -> Val a
fresh Ctx a
ctx Text
x)

                                    let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'

                                    -- x appearing in _T₁'' would indicate a disallowed
                                    -- handler type (see
                                    -- https://github.com/dhall-lang/dhall-lang/issues/749).
                                    --
                                    -- If x appears in _T₁'', quote will have given it index
                                    -- -1. Any well-typed variable has a non-negative index,
                                    -- so we can simply look for negative indices to detect x.
                                    let containsBadVar :: Expr s a -> Bool
containsBadVar (Var (V Text
_ Int
n)) =
                                            Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0

                                        containsBadVar Expr s a
e =
                                            FoldLike Any (Expr s a) (Expr s a) (Expr s a) (Expr s a)
-> (Expr s a -> Bool) -> Expr s a -> Bool
forall s t a b. FoldLike Any s t a b -> (a -> Bool) -> s -> Bool
Lens.Family.anyOf
                                                FoldLike Any (Expr s a) (Expr s a) (Expr s a) (Expr s a)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Dhall.Core.subExpressions
                                                Expr s a -> Bool
containsBadVar
                                                Expr s a
e

                                    if Expr Any a -> Bool
forall s a. Expr s a -> Bool
containsBadVar Expr Any a
forall s. Expr s a
_T₁''
                                        then do
                                            let handler'' :: Expr s a
handler'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
handler'

                                            let outputType :: Expr s a
outputType = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift Int
1 (Text -> Int -> Var
V Text
x (-Int
1)) Expr s a
forall s. Expr s a
_T₁''

                                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> Text -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> Text -> TypeMessage s a
DisallowedHandlerType Text
y Expr s a
forall s. Expr s a
handler'' Expr s a
forall s. Expr s a
outputType Text
x)

                                        else Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₁'

                                else do
                                    let _A₀'' :: Expr s a
_A₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₀'
                                    let _A₁'' :: Expr s a
_A₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₁'

                                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
HandlerInputTypeMismatch Text
y Expr s a
forall s. Expr s a
_A₁'' Expr s a
forall s. Expr s a
_A₀'')

                        Maybe (Text, Val a, Val a -> Val a)
Nothing -> do
                            let handler'' :: Expr s a
handler'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
handler'

                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
HandlerNotAFunction Text
y Expr s a
forall s. Expr s a
handler'')

            Map Text (Val a)
matched <-
                Map Text (Either (TypeError s a) (Val a))
-> Either (TypeError s a) (Map Text (Val a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                    ((Text -> Val a -> Maybe (Val a) -> Either (TypeError s a) (Val a))
-> Map Text (Val a)
-> Map Text (Maybe (Val a))
-> Map Text (Either (TypeError s a) (Val a))
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Data.Map.intersectionWithKey Text -> Val a -> Maybe (Val a) -> Either (TypeError s a) (Val a)
match (Map Text (Val a) -> Map Text (Val a)
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text (Val a)
yTs') (Map Text (Maybe (Val a)) -> Map Text (Maybe (Val a))
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text (Maybe (Val a))
yUs'))

            let checkMatched :: Data.Map.Map Text (Val a) -> Either (TypeError s a) (Maybe (Val a))
                checkMatched :: Map Text (Val a) -> Either (TypeError s a) (Maybe (Val a))
checkMatched = (Maybe (Text, Val a) -> Maybe (Val a))
-> Either (TypeError s a) (Maybe (Text, Val a))
-> Either (TypeError s a) (Maybe (Val a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text, Val a) -> Val a) -> Maybe (Text, Val a) -> Maybe (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Val a) -> Val a
forall a b. (a, b) -> b
snd) (Either (TypeError s a) (Maybe (Text, Val a))
 -> Either (TypeError s a) (Maybe (Val a)))
-> (Map Text (Val a)
    -> Either (TypeError s a) (Maybe (Text, Val a)))
-> Map Text (Val a)
-> Either (TypeError s a) (Maybe (Val a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Val a)
 -> (Text, Val a) -> Either (TypeError s a) (Maybe (Text, Val a)))
-> Maybe (Text, Val a)
-> [(Text, Val a)]
-> Either (TypeError s a) (Maybe (Text, Val a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM Maybe (Text, Val a)
-> (Text, Val a) -> Either (TypeError s a) (Maybe (Text, Val a))
go Maybe (Text, Val a)
forall a. Maybe a
Nothing ([(Text, Val a)] -> Either (TypeError s a) (Maybe (Text, Val a)))
-> (Map Text (Val a) -> [(Text, Val a)])
-> Map Text (Val a)
-> Either (TypeError s a) (Maybe (Text, Val a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Val a) -> [(Text, Val a)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList
                  where
                    go :: Maybe (Text, Val a)
-> (Text, Val a) -> Either (TypeError s a) (Maybe (Text, Val a))
go Maybe (Text, Val a)
Nothing (Text
y₁, Val a
_T₁') =
                        Maybe (Text, Val a) -> Either (TypeError s a) (Maybe (Text, Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Val a) -> Maybe (Text, Val a)
forall a. a -> Maybe a
Just (Text
y₁, Val a
_T₁'))

                    go yT₀' :: Maybe (Text, Val a)
yT₀'@(Just (Text
y₀, Val a
_T₀')) (Text
y₁, Val a
_T₁') =
                        if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_T₀' Val a
_T₁'
                            then Maybe (Text, Val a) -> Either (TypeError s a) (Maybe (Text, Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Val a)
yT₀'

                            else do
                                let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'
                                let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'
                                TypeMessage s a -> Either (TypeError s a) (Maybe (Text, Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Text -> Expr s a -> TypeMessage s a
HandlerOutputTypeMismatch Text
y₀ Expr s a
forall s. Expr s a
_T₀'' Text
y₁ Expr s a
forall s. Expr s a
_T₁'')

            Maybe (Val a)
mT₀' <- Map Text (Val a) -> Either (TypeError s a) (Maybe (Val a))
checkMatched Map Text (Val a)
matched

            Maybe (Val a)
mT₁' <- Maybe (Expr s a)
-> (Expr s a -> Either (TypeError s a) (Val a))
-> Either (TypeError s a) (Maybe (Val a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
Data.Traversable.for Maybe (Expr s a)
mT₁ ((Expr s a -> Either (TypeError s a) (Val a))
 -> Either (TypeError s a) (Maybe (Val a)))
-> (Expr s a -> Either (TypeError s a) (Val a))
-> Either (TypeError s a) (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ \Expr s a
_T₁ -> do
                Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T₁

                Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_T₁)

            case (Maybe (Val a)
mT₀', Maybe (Val a)
mT₁') of
                (Maybe (Val a)
Nothing, Maybe (Val a)
Nothing) ->
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
MissingMergeType
                (Maybe (Val a)
Nothing, Just Val a
_T₁') ->
                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₁'
                (Just Val a
_T₀', Maybe (Val a)
Nothing) ->
                    Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'
                (Just Val a
_T₀', Just Val a
_T₁') ->
                    if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_T₀' Val a
_T₁'
                        then Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'

                        else do
                            let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'
                            let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'
                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
AnnotMismatch (Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr s a
t Expr s a
u Maybe (Expr s a)
forall a. Maybe a
Nothing) Expr s a
forall s. Expr s a
_T₁'' Expr s a
forall s. Expr s a
_T₀'')

        ToMap Expr s a
e Maybe (Expr s a)
mT₁ -> do
            Val a
_E' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e

            let _E'' :: Expr s a
_E'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_E'

            Map Text (Val a)
xTs' <- case Val a
_E' of
                VRecord Map Text (Val a)
xTs' -> Map Text (Val a) -> Either (TypeError s a) (Map Text (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Val a)
xTs'
                Val a
_            -> TypeMessage s a -> Either (TypeError s a) (Map Text (Val a))
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMapARecord Expr s a
e Expr s a
forall s. Expr s a
_E'')

            Val a
tE' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
forall s. Expr s a
_E''

            let tE'' :: Expr s a
tE'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tE'

            case Val a
tE' of
                VConst Const
Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_           -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
InvalidToMapRecordKind Expr s a
forall s. Expr s a
_E'' Expr s a
forall s. Expr s a
tE'')

            (Expr s a -> Either (TypeError s a) (Val a))
-> Maybe (Expr s a) -> Either (TypeError s a) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ (Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx) Maybe (Expr s a)
mT₁

            let compareFieldTypes :: Val a
-> Maybe (Either (TypeError s a) (Val a))
-> Maybe (Either (TypeError s a) (Val a))
compareFieldTypes Val a
_T₀' Maybe (Either (TypeError s a) (Val a))
Nothing =
                    Either (TypeError s a) (Val a)
-> Maybe (Either (TypeError s a) (Val a))
forall a. a -> Maybe a
Just (Val a -> Either (TypeError s a) (Val a)
forall a b. b -> Either a b
Right Val a
_T₀')

                compareFieldTypes Val a
_T₀' r :: Maybe (Either (TypeError s a) (Val a))
r@(Just (Right Val a
_T₁'))
                    | Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_T₀' Val a
_T₁' = Maybe (Either (TypeError s a) (Val a))
r
                    | Bool
otherwise = do
                        let _T₀'' :: Expr s a
_T₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₀'
                        let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'

                        Either (TypeError s a) (Val a)
-> Maybe (Either (TypeError s a) (Val a))
forall a. a -> Maybe a
Just (TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
HeterogenousRecordToMap Expr s a
forall s. Expr s a
_E'' Expr s a
forall s. Expr s a
_T₀'' Expr s a
forall s. Expr s a
_T₁''))

                compareFieldTypes Val a
_T₀' r :: Maybe (Either (TypeError s a) (Val a))
r@(Just (Left TypeError s a
_)) =
                    Maybe (Either (TypeError s a) (Val a))
r

            let r :: Maybe (Either (TypeError s a) (Val a))
r = Endo (Maybe (Either (TypeError s a) (Val a)))
-> Maybe (Either (TypeError s a) (Val a))
-> Maybe (Either (TypeError s a) (Val a))
forall a. Endo a -> a -> a
appEndo ((Val a -> Endo (Maybe (Either (TypeError s a) (Val a))))
-> Map Text (Val a)
-> Endo (Maybe (Either (TypeError s a) (Val a)))
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Maybe (Either (TypeError s a) (Val a))
 -> Maybe (Either (TypeError s a) (Val a)))
-> Endo (Maybe (Either (TypeError s a) (Val a)))
forall a. (a -> a) -> Endo a
Endo ((Maybe (Either (TypeError s a) (Val a))
  -> Maybe (Either (TypeError s a) (Val a)))
 -> Endo (Maybe (Either (TypeError s a) (Val a))))
-> (Val a
    -> Maybe (Either (TypeError s a) (Val a))
    -> Maybe (Either (TypeError s a) (Val a)))
-> Val a
-> Endo (Maybe (Either (TypeError s a) (Val a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val a
-> Maybe (Either (TypeError s a) (Val a))
-> Maybe (Either (TypeError s a) (Val a))
compareFieldTypes) Map Text (Val a)
xTs') Maybe (Either (TypeError s a) (Val a))
forall a. Maybe a
Nothing

            let mT₁' :: Maybe (Val a)
mT₁' = (Expr s a -> Val a) -> Maybe (Expr s a) -> Maybe (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values) Maybe (Expr s a)
mT₁

            let mapType :: Val a -> Val a
mapType Val a
_T' =
                    Val a -> Val a
forall a. Val a -> Val a
VList
                        (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord
                            ([(Text, Val a)] -> Map Text (Val a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.unorderedFromList
                                [(Text
"mapKey", Val a
forall a. Val a
VText), (Text
"mapValue", Val a
_T')]
                            )
                        )

            case (Maybe (Either (TypeError s a) (Val a))
r, Maybe (Val a)
mT₁') of
                (Maybe (Either (TypeError s a) (Val a))
Nothing, Maybe (Val a)
Nothing) ->
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
MissingToMapType
                (Just err :: Either (TypeError s a) (Val a)
err@(Left TypeError s a
_), Maybe (Val a)
_) ->
                    Either (TypeError s a) (Val a)
err
                (Just (Right Val a
_T'), Maybe (Val a)
Nothing) ->
                    Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val a -> Val a
forall a. Val a -> Val a
mapType Val a
_T')
                (Maybe (Either (TypeError s a) (Val a))
Nothing, Just _T₁' :: Val a
_T₁'@(VList (VRecord Map Text (Val a)
itemTypes)))
                   | Just Val a
_T' <- Text -> Map Text (Val a) -> Maybe (Val a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"mapValue" Map Text (Val a)
itemTypes
                   , Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values (Val a -> Val a
forall a. Val a -> Val a
mapType Val a
_T') Val a
_T₁' ->
                       Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val a
_T₁'
                (Maybe (Either (TypeError s a) (Val a))
Nothing, Just Val a
_T₁') -> do
                    let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'

                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
InvalidToMapType Expr s a
forall s. Expr s a
_T₁'')
                (Just (Right Val a
_T'), Just Val a
_T₁')
                   | Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values (Val a -> Val a
forall a. Val a -> Val a
mapType Val a
_T') Val a
_T₁' ->
                       Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val a -> Val a
forall a. Val a -> Val a
mapType Val a
_T')
                   | Bool
otherwise -> do
                       let _T₁'' :: Expr s a
_T₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_T₁'

                       TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MapTypeMismatch (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Val a -> Val a
forall a. Val a -> Val a
mapType Val a
_T')) Expr s a
forall s. Expr s a
_T₁'')

        ShowConstructor Expr s a
e -> do
            Val a
_E' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e
            case Val a
_E' of
              VUnion Map Text (Maybe (Val a))
_ -> Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val a
forall a. Val a
VText
              VOptional Val a
_ -> Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val a
forall a. Val a
VText

              Val a
_ -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
ShowConstructorNotOnUnion

        Field Expr s a
e (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Syntax.fieldSelectionLabel -> Text
x) -> do
            Val a
_E' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e

            let _E'' :: Expr s a
_E'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_E'

            case Val a
_E' of
                VRecord Map Text (Val a)
xTs' ->
                    case Text -> Map Text (Val a) -> Maybe (Val a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
x Map Text (Val a)
xTs' of
                        Just Val a
_T' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T'
                        Maybe (Val a)
Nothing  -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
MissingField Text
x Expr s a
forall s. Expr s a
_E'')
                Val a
_ -> do
                    let e' :: Val a
e' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
e

                    let e'' :: Expr s a
e'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
e'

                    case Val a
e' of
                        VUnion Map Text (Maybe (Val a))
xTs' ->
                            case Text -> Map Text (Maybe (Val a)) -> Maybe (Maybe (Val a))
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
x Map Text (Maybe (Val a))
xTs' of
                                Just (Just Val a
_T') -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
x Val a
_T' (\Val a
_ -> Val a
e'))
                                Just  Maybe (Val a)
Nothing   -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
e'
                                Maybe (Maybe (Val a))
Nothing         -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
MissingConstructor Text
x Expr s a
e)

                        Val a
_ -> do
                            let text :: Text
text = Doc Ann -> Text
forall ann. Doc ann -> Text
Dhall.Pretty.Internal.docToStrictText (Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
x)

                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
CantAccess Text
text Expr s a
forall s. Expr s a
e'' Expr s a
forall s. Expr s a
_E'')
        Project Expr s a
e (Left [Text]
xs) -> do
            case [Text] -> Maybe Text
forall a. Ord a => [a] -> Maybe a
duplicateElement [Text]
xs of
                Just Text
x -> do
                    TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> TypeMessage s a
forall s a. Text -> TypeMessage s a
DuplicateProjectionLabel Text
x)
                Maybe Text
Nothing -> do
                    () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            Val a
_E' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e

            let _E'' :: Expr s a
_E'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_E'

            case Val a
_E' of
                VRecord Map Text (Val a)
xTs' -> do
                    let process :: Text -> Either (TypeError s a) (Text, Val a)
process Text
x =
                            case Text -> Map Text (Val a) -> Maybe (Val a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
x Map Text (Val a)
xTs' of
                                Just Val a
_T' -> (Text, Val a) -> Either (TypeError s a) (Text, Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Val a
_T')
                                Maybe (Val a)
Nothing  -> TypeMessage s a -> Either (TypeError s a) (Text, Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
MissingField Text
x Expr s a
forall s. Expr s a
_E'')

                    let adapt :: [(Text, Val a)] -> Val a
adapt = Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord (Map Text (Val a) -> Val a)
-> ([(Text, Val a)] -> Map Text (Val a))
-> [(Text, Val a)]
-> Val a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Val a)] -> Map Text (Val a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.unorderedFromList

                    ([(Text, Val a)] -> Val a)
-> Either (TypeError s a) [(Text, Val a)]
-> Either (TypeError s a) (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Val a)] -> Val a
forall a. [(Text, Val a)] -> Val a
adapt ((Text -> Either (TypeError s a) (Text, Val a))
-> [Text] -> Either (TypeError s a) [(Text, Val a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either (TypeError s a) (Text, Val a)
process [Text]
xs)

                Val a
_ -> do
                    let text :: Text
text =
                            Doc Ann -> Text
forall ann. Doc ann -> Text
Dhall.Pretty.Internal.docToStrictText ([Text] -> Doc Ann
Dhall.Pretty.Internal.prettyLabels [Text]
xs)

                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
CantProject Text
text Expr s a
e Expr s a
forall s. Expr s a
_E'')

        Project Expr s a
e (Right Expr s a
s) -> do
            Val a
_E' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e

            let _E'' :: Expr s a
_E'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_E'

            case Val a
_E' of
                VRecord Map Text (Val a)
xEs' -> do
                    Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
s

                    let s' :: Val a
s' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
s

                    case Val a
s' of
                        VRecord Map Text (Val a)
xSs' -> do
                            let actualSubset :: Expr s a
actualSubset =
                                    Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord (Map Text (Val a) -> Map Text (Val a) -> Map Text (Val a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Dhall.Map.intersection Map Text (Val a)
xEs' Map Text (Val a)
xSs'))

                            let expectedSubset :: Expr s a
expectedSubset = Expr s a
s

                            let process :: Text -> Val a -> Either (TypeError s a) ()
process Text
x Val a
_S' = do
                                    let _S'' :: Expr s a
_S'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_S'

                                    case Text -> Map Text (Val a) -> Maybe (Val a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
x Map Text (Val a)
xEs' of
                                        Maybe (Val a)
Nothing ->
                                            TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> TypeMessage s a
MissingField Text
x Expr s a
forall s. Expr s a
_E'')

                                        Just Val a
_E' ->
                                            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_E' Val a
_S'
                                                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                else TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text
-> Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Text
-> Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
ProjectionTypeMismatch Text
x Expr s a
forall s. Expr s a
_E'' Expr s a
forall s. Expr s a
_S'' Expr s a
expectedSubset Expr s a
forall s. Expr s a
actualSubset)

                            (Text -> Val a -> Either (TypeError s a) ())
-> Map Text (Val a) -> Either (TypeError s a) ()
forall k (f :: * -> *) a.
(Ord k, Applicative f) =>
(k -> a -> f ()) -> Map k a -> f ()
Dhall.Map.unorderedTraverseWithKey_ Text -> Val a -> Either (TypeError s a) ()
process Map Text (Val a)
xSs'

                            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
s'

                        Val a
_ ->
                            TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
CantProjectByExpression Expr s a
s)

                Val a
_ -> do
                    let text :: Text
text = Expr s a -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr s a
s

                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> Expr s a -> Expr s a -> TypeMessage s a
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
CantProject Text
text Expr s a
e Expr s a
s)

        Assert Expr s a
_T -> do
            Val a
_ <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
_T

            let _T' :: Val a
_T' = Environment a -> Expr s a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values Expr s a
_T

            case Val a
_T' of
                VEquivalent Val a
x' Val a
y' -> do
                    let x'' :: Expr s a
x'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
x'
                    let y'' :: Expr s a
y'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
y'

                    if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
x' Val a
y'
                        then Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T'
                        else TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
AssertionFailed Expr s a
forall s. Expr s a
x'' Expr s a
forall s. Expr s a
y'')

                Val a
_ ->
                    TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
NotAnEquivalence Expr s a
_T)

        Equivalent Maybe CharacterSet
_ Expr s a
x Expr s a
y -> do
            Val a
_A₀' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
x

            let _A₀'' :: Expr s a
_A₀'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₀'

            Val a
tA₀' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
forall s. Expr s a
_A₀''

            case Val a
tA₀' of
                VConst Const
Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_          -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
IncomparableExpression Expr s a
x)

            Val a
_A₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
y

            let _A₁'' :: Expr s a
_A₁'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
_A₁'

            Val a
tA₁' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
forall s. Expr s a
_A₁''

            case Val a
tA₁' of
                VConst Const
Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Val a
_           -> TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> TypeMessage s a
forall s a. Expr s a -> TypeMessage s a
IncomparableExpression Expr s a
y)

            if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_A₀' Val a
_A₁'
                then () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
EquivalenceTypeMismatch Expr s a
x Expr s a
forall s. Expr s a
_A₀'' Expr s a
y Expr s a
forall s. Expr s a
_A₁'')

            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Const -> Val a
forall a. Const -> Val a
VConst Const
Type)

        With Expr s a
e₀ NonEmpty WithComponent
ks₀ Expr s a
v₀ -> do
            Val a
tE₀' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e₀

            -- The purpose of this inner loop is to ensure that we only need to
            -- typecheck the record once

            let with :: Val a
-> NonEmpty WithComponent
-> Expr s a
-> Either (TypeError s a) (Val a)
with Val a
tE' NonEmpty WithComponent
ks Expr s a
v = case Val a
tE' of
                  VRecord Map Text (Val a)
kTs' ->
                    case NonEmpty WithComponent
ks of
                      WithLabel Text
k :| [] -> do
                          Val a
tV' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
v

                          Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord (Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
k Val a
tV' Map Text (Val a)
kTs'))
                      WithLabel Text
k₀ :| WithComponent
k₁ : [WithComponent]
ks' -> do
                          let _T :: Val a
_T =
                                  case Text -> Map Text (Val a) -> Maybe (Val a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
k₀ Map Text (Val a)
kTs' of
                                      Just Val a
_T' -> Val a
_T'
                                      Maybe (Val a)
Nothing  -> Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord Map Text (Val a)
forall a. Monoid a => a
mempty

                          Val a
tV' <- Val a
-> NonEmpty WithComponent
-> Expr s a
-> Either (TypeError s a) (Val a)
with Val a
_T (WithComponent
k₁ WithComponent -> [WithComponent] -> NonEmpty WithComponent
forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks') Expr s a
v

                          Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Val a) -> Val a
forall a. Map Text (Val a) -> Val a
VRecord (Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
k₀ Val a
tV' Map Text (Val a)
kTs'))
                      WithComponent
WithQuestion :| [WithComponent]
_ -> do
                          TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
NotALabelPath

                  VOptional Val a
_O' -> do
                    case NonEmpty WithComponent
ks of
                      WithComponent
WithQuestion  :| [] -> do
                        Val a
tV' <- Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
v
                        if Environment a -> Val a -> Val a -> Bool
forall a. Eq a => Environment a -> Val a -> Val a -> Bool
Eval.conv Environment a
values Val a
_O' Val a
tV'
                          then Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
_O')
                          else TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
forall s a. TypeMessage s a
OptionalWithTypeMismatch

                      WithComponent
WithQuestion :| WithComponent
k₁ : [WithComponent]
ks' -> do
                        Val a
tV' <- Val a
-> NonEmpty WithComponent
-> Expr s a
-> Either (TypeError s a) (Val a)
with Val a
_O' (WithComponent
k₁ WithComponent -> [WithComponent] -> NonEmpty WithComponent
forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks') Expr s a
v
                        Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
tV')

                      WithLabel Text
k :| [WithComponent]
_ -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Text -> TypeMessage s a
forall s a. Text -> TypeMessage s a
NotAQuestionPath Text
k)

                  Val a
_ -> TypeMessage s a -> Either (TypeError s a) (Val a)
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Expr s a -> Expr s a -> TypeMessage s a
forall s a. Expr s a -> Expr s a -> TypeMessage s a
NotWithARecord Expr s a
e₀ (Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tE')) -- TODO: NotWithARecordOrOptional

            Val a
-> NonEmpty WithComponent
-> Expr s a
-> Either (TypeError s a) (Val a)
with Val a
tE₀' NonEmpty WithComponent
ks₀ Expr s a
v₀

        Note s
s Expr s a
e ->
            case Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
e of
                Left (TypeError Context (Expr s a)
ctx' (Note s
s' Expr s a
e') TypeMessage s a
m) ->
                    TypeError s a -> Either (TypeError s a) (Val a)
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
ctx' (s -> Expr s a -> Expr s a
forall s a. s -> Expr s a -> Expr s a
Note s
s' Expr s a
e') TypeMessage s a
m)
                Left (TypeError Context (Expr s a)
ctx'          Expr s a
e'  TypeMessage s a
m) ->
                    TypeError s a -> Either (TypeError s a) (Val a)
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
ctx' (s -> Expr s a -> Expr s a
forall s a. s -> Expr s a -> Expr s a
Note s
s  Expr s a
e') TypeMessage s a
m)
                Right Val a
r ->
                    Val a -> Either (TypeError s a) (Val a)
forall a b. b -> Either a b
Right Val a
r

        ImportAlt Expr s a
l Expr s a
_r ->
            Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l

        Embed a
p ->
            Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Environment a -> Expr Any a -> Val a
forall a s. Eq a => Environment a -> Expr s a -> Val a
eval Environment a
values (a -> Expr Any a
Typer a
typer a
p))
      where
        die :: TypeMessage s a -> Either (TypeError s a) b
die TypeMessage s a
err = TypeError s a -> Either (TypeError s a) b
forall a b. a -> Either a b
Left (Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr s a)
forall s. Context (Expr s a)
context Expr s a
expression TypeMessage s a
err)

        context :: Context (Expr s a)
context = Ctx a -> Context (Expr s a)
forall a s. Eq a => Ctx a -> Context (Expr s a)
ctxToContext Ctx a
ctx

        names :: Names
names = Types a -> Names
forall a. Types a -> Names
typesToNames Types a
types

        eval :: Environment a -> Expr s a -> Val a
eval Environment a
vs Expr s a
e = Environment a -> Expr X a -> Val a
forall a. Eq a => Environment a -> Expr X a -> Val a
Eval.eval Environment a
vs (Expr s a -> Expr X a
forall s a t. Expr s a -> Expr t a
Dhall.Core.denote Expr s a
e)

        quote :: Names -> Val a -> Expr s a
quote Names
ns Val a
value = Expr X a -> Expr s a
forall a s. Expr X a -> Expr s a
Dhall.Core.renote (Names -> Val a -> Expr X a
forall a. Eq a => Names -> Val a -> Expr X a
Eval.quote Names
ns Val a
value)

{-| `typeOf` is the same as `typeWith` with an empty context, meaning that the
    expression must be closed (i.e. no free variables), otherwise type-checking
    will fail.
-}
typeOf :: Expr s X -> Either (TypeError s X) (Expr s X)
typeOf :: Expr s X -> Either (TypeError s X) (Expr s X)
typeOf = Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
forall s.
Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
typeWith Context (Expr s X)
forall a. Context a
Dhall.Context.empty

-- | The specific type error
data TypeMessage s a
    = UnboundVariable Text
    | InvalidInputType (Expr s a)
    | InvalidOutputType (Expr s a)
    | NotAFunction (Expr s a) (Expr s a)
    | TypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a)
    | AnnotMismatch (Expr s a) (Expr s a) (Expr s a)
    | Untyped
    | MissingListType
    | MismatchedListElements Int (Expr s a) (Expr s a) (Expr s a)
    | InvalidListElement Int (Expr s a) (Expr s a) (Expr s a)
    | InvalidListType (Expr s a)
    | ListLitInvariant
    | InvalidSome (Expr s a) (Expr s a) (Expr s a)
    | InvalidPredicate (Expr s a) (Expr s a)
    | IfBranchMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a)
    | InvalidFieldType Text (Expr s a)
    | InvalidAlternativeType Text (Expr s a)
    | ListAppendMismatch (Expr s a) (Expr s a)
    | MustUpdateARecord (Expr s a) (Expr s a) (Expr s a)
    | MustCombineARecord Char (Expr s a) (Expr s a)
    | InvalidDuplicateField Text (Expr s a) (Expr s a)
    | InvalidRecordCompletion Text (Expr s a)
    | CompletionSchemaMustBeARecord (Expr s a) (Expr s a)
    | CombineTypesRequiresRecordType (Expr s a) (Expr s a)
    | RecordTypeMismatch Const Const (Expr s a) (Expr s a)
    | DuplicateFieldCannotBeMerged (NonEmpty Text)
    | FieldCollision (NonEmpty Text)
    | FieldTypeCollision (NonEmpty Text)
    | MustMergeARecord (Expr s a) (Expr s a)
    | MustMergeUnionOrOptional (Expr s a) (Expr s a)
    | MustMapARecord (Expr s a) (Expr s a)
    | InvalidToMapRecordKind (Expr s a) (Expr s a)
    | HeterogenousRecordToMap (Expr s a) (Expr s a) (Expr s a)
    | InvalidToMapType (Expr s a)
    | MapTypeMismatch (Expr s a) (Expr s a)
    | MissingToMapType
    | UnusedHandler (Set Text)
    | MissingHandler Text (Set Text)
    | HandlerInputTypeMismatch Text (Expr s a) (Expr s a)
    | DisallowedHandlerType Text (Expr s a) (Expr s a) Text
    | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a)
    | InvalidHandlerOutputType Text (Expr s a) (Expr s a)
    | MissingMergeType
    | HandlerNotAFunction Text (Expr s a)
    | CantAccess Text (Expr s a) (Expr s a)
    | CantProject Text (Expr s a) (Expr s a)
    | CantProjectByExpression (Expr s a)
    | DuplicateProjectionLabel Text
    | MissingField Text (Expr s a)
    | MissingConstructor Text (Expr s a)
    | ProjectionTypeMismatch Text (Expr s a) (Expr s a) (Expr s a) (Expr s a)
    | AssertionFailed (Expr s a) (Expr s a)
    | NotAnEquivalence (Expr s a)
    | IncomparableExpression (Expr s a)
    | EquivalenceTypeMismatch (Expr s a) (Expr s a) (Expr s a) (Expr s a)
    | NotWithARecord (Expr s a) (Expr s a)
    | CantAnd (Expr s a) (Expr s a)
    | CantOr (Expr s a) (Expr s a)
    | CantEQ (Expr s a) (Expr s a)
    | CantNE (Expr s a) (Expr s a)
    | CantInterpolate (Expr s a) (Expr s a)
    | CantTextAppend (Expr s a) (Expr s a)
    | CantListAppend (Expr s a) (Expr s a)
    | CantAdd (Expr s a) (Expr s a)
    | CantMultiply (Expr s a) (Expr s a)
    | OptionalWithTypeMismatch
    | NotALabelPath
    | NotAQuestionPath Text
    | ShowConstructorNotOnUnion
    deriving (Int -> TypeMessage s a -> ShowS
[TypeMessage s a] -> ShowS
TypeMessage s a -> String
(Int -> TypeMessage s a -> ShowS)
-> (TypeMessage s a -> String)
-> ([TypeMessage s a] -> ShowS)
-> Show (TypeMessage s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. (Show s, Show a) => Int -> TypeMessage s a -> ShowS
forall s a. (Show s, Show a) => [TypeMessage s a] -> ShowS
forall s a. (Show s, Show a) => TypeMessage s a -> String
showList :: [TypeMessage s a] -> ShowS
$cshowList :: forall s a. (Show s, Show a) => [TypeMessage s a] -> ShowS
show :: TypeMessage s a -> String
$cshow :: forall s a. (Show s, Show a) => TypeMessage s a -> String
showsPrec :: Int -> TypeMessage s a -> ShowS
$cshowsPrec :: forall s a. (Show s, Show a) => Int -> TypeMessage s a -> ShowS
Show)

formatHints :: [Doc Ann] -> Doc Ann
formatHints :: [Doc Ann] -> Doc Ann
formatHints [Doc Ann]
hints = [Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
vsep ((Doc Ann -> Doc Ann) -> [Doc Ann] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Doc Ann -> Doc Ann
forall a. (Semigroup a, IsString a) => a -> a
format [Doc Ann]
hints)
  where
    format :: a -> a
format a
hint = a
"\n\n\ESC[1;33mHint\ESC[0m: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
hint

shortTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
shortTypeMessage :: TypeMessage s a -> Doc Ann
shortTypeMessage TypeMessage s a
msg =
    Doc Ann
"\ESC[1;31mError\ESC[0m: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
short Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> [Doc Ann] -> Doc Ann
formatHints [Doc Ann]
hints Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
  where
    ErrorMessages {[Doc Ann]
Doc Ann
long :: ErrorMessages -> Doc Ann
hints :: ErrorMessages -> [Doc Ann]
short :: ErrorMessages -> Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..} = TypeMessage s a -> ErrorMessages
forall a s. (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
prettyTypeMessage TypeMessage s a
msg

longTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
longTypeMessage :: TypeMessage s a -> Doc Ann
longTypeMessage TypeMessage s a
msg =
        Doc Ann
"\ESC[1;31mError\ESC[0m: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
short Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> [Doc Ann] -> Doc Ann
formatHints [Doc Ann]
hints Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
long
  where
    ErrorMessages {[Doc Ann]
Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
long :: ErrorMessages -> Doc Ann
hints :: ErrorMessages -> [Doc Ann]
short :: ErrorMessages -> Doc Ann
..} = TypeMessage s a -> ErrorMessages
forall a s. (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
prettyTypeMessage TypeMessage s a
msg

{-| Output of `prettyTypeMessage`, containing short- and long-form error
    messages
-}
data ErrorMessages = ErrorMessages
    { ErrorMessages -> Doc Ann
short :: Doc Ann
    -- ^ Default succinct 1-line explanation of what went wrong
    , ErrorMessages -> [Doc Ann]
hints :: [Doc Ann]
    -- ^ Possibly-empty hints based on specific types involved in the error
    , ErrorMessages -> Doc Ann
long  :: Doc Ann
    -- ^ Longer and more detailed explanation of the error
    }

_NOT :: Doc ann
_NOT :: Doc ann
_NOT = Doc ann
"\ESC[1mnot\ESC[0m"

insert :: Pretty a => a -> Doc Ann
insert :: a -> Doc Ann
insert = a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert

emptyRecordTypeHint :: (Eq a, Pretty a) => Expr s a -> [Doc Ann]
emptyRecordTypeHint :: Expr s a -> [Doc Ann]
emptyRecordTypeHint Expr s a
expr =
    if Expr s a -> Expr Any a -> Bool
forall a s t. Eq a => Expr s a -> Expr t a -> Bool
Eval.judgmentallyEqual Expr s a
expr (Map Text (RecordField Any a) -> Expr Any a
forall s a. Map Text (RecordField s a) -> Expr s a
Record Map Text (RecordField Any a)
forall a. Monoid a => a
mempty) then
        [Doc Ann
"{} is the empty record type, use {=} for the empty record value"]
    else []

-- | Convert a `TypeMessage` to short- and long-form `ErrorMessages`
prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
prettyTypeMessage :: TypeMessage s a -> ErrorMessages
prettyTypeMessage (UnboundVariable Text
x) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
forall ann. Doc ann
long :: Doc Ann
hints :: forall a. [a]
short :: forall ann. Doc ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  -- We do not need to print variable name here. For the discussion see:
  -- https://github.com/dhall-lang/dhall-haskell/pull/116
  where
    short :: Doc ann
short = Doc ann
"Unbound variable: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
x
    
    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Expressions can only reference previously introduced (i.e. “bound”)\n\
        \variables that are still “in scope”                                             \n\
        \                                                                                \n\
        \For example, the following valid expressions introduce a “bound” variable named \n\
        \❰x❱:                                                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ λ(x : Bool) → x │  Anonymous functions introduce “bound” variables        \n\
        \    └─────────────────┘                                                         \n\
        \        ⇧                                                                       \n\
        \        This is the bound variable                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ let x = 1 in x  │  ❰let❱ expressions introduce “bound” variables          \n\
        \    └─────────────────┘                                                         \n\
        \          ⇧                                                                     \n\
        \          This is the bound variable                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, the following expressions are not valid because they all reference a   \n\
        \variable that has not been introduced yet (i.e. an “unbound” variable):         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ λ(x : Bool) → y │  The variable ❰y❱ hasn't been introduced yet            \n\
        \    └─────────────────┘                                                         \n\
        \                    ⇧                                                           \n\
        \                    This is the unbound variable                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────┐                                                \n\
        \    │ (let x = True in x) && x │  ❰x❱ is undefined outside the parentheses      \n\
        \    └──────────────────────────┘                                                \n\
        \                             ⇧                                                  \n\
        \                             This is the unbound variable                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ let x = x in x │  The definition for ❰x❱ cannot reference itself          \n\
        \    └────────────────┘                                                          \n\
        \              ⇧                                                                 \n\
        \              This is the unbound variable                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You misspell a variable name, like this:                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────────────┐                      \n\
        \    │ λ(empty : Bool) → if emty then \"Empty\" else \"Full\" │                      \n\
        \    └────────────────────────────────────────────────────┘                      \n\
        \                           ⇧                                                    \n\
        \                           Typo                                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You misspell a reserved identifier, like this:                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────┐                                                \n\
        \    │ foral (a : Type) → a → a │                                                \n\
        \    └──────────────────────────┘                                                \n\
        \      ⇧                                                                         \n\
        \      Typo                                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You tried to define a recursive value, like this:                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ let x = x + 1 in x │                                                      \n\
        \    └────────────────────┘                                                      \n\
        \              ⇧                                                                 \n\
        \              Recursive definitions are not allowed                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You accidentally forgot a ❰λ❱ or ❰∀❱/❰forall❱                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \        Unbound variable                                                        \n\
        \        ⇩                                                                       \n\
        \    ┌─────────────────┐                                                         \n\
        \    │  (x : Bool) → x │                                                         \n\
        \    └─────────────────┘                                                         \n\
        \      ⇧                                                                         \n\
        \      A ❰λ❱ here would transform this into a valid anonymous function           \n\
        \                                                                                \n\
        \                                                                                \n\
        \        Unbound variable                                                        \n\
        \        ⇩                                                                       \n\
        \    ┌────────────────────┐                                                      \n\
        \    │  (x : Bool) → Bool │                                                      \n\
        \    └────────────────────┘                                                      \n\
        \      ⇧                                                                         \n\
        \      A ❰∀❱ or ❰forall❱ here would transform this into a valid function type    \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You forgot to prefix a file path with ❰./❱:                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ path/to/file.dhall │                                                      \n\
        \    └────────────────────┘                                                      \n\
        \      ⇧                                                                         \n\
        \      This should be ❰./path/to/file.dhall❱                                     \n"

prettyTypeMessage (InvalidInputType Expr s a
expr) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Invalid function input"
    
    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: A function can accept an input “term” that has a given “type”, like\n\
        \this:                                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \        This is the input term that the function accepts                        \n\
        \        ⇩                                                                       \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ ∀(x : Natural) → Bool │  This is the type of a function that accepts an   \n\
        \    └───────────────────────┘  input term named ❰x❱ that has type ❰Natural❱     \n\
        \            ⇧                                                                   \n\
        \            This is the type of the input term                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ Bool → Natural │  This is the type of a function that accepts an anonymous\n\
        \    └────────────────┘  input term that has type ❰Bool❱                         \n\
        \      ⇧                                                                         \n\
        \      This is the type of the input term                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \... or a function can accept an input “type” that has a given “kind”, like this:\n\
        \                                                                                \n\
        \                                                                                \n\
        \        This is the input type that the function accepts                        \n\
        \        ⇩                                                                       \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ ∀(a : Type) → Type │  This is the type of a function that accepts an input\n\
        \    └────────────────────┘  type named ❰a❱ that has kind ❰Type❱                 \n\
        \            ⇧                                                                   \n\
        \            This is the kind of the input type                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ (Type → Type) → Type │  This is the type of a function that accepts an    \n\
        \    └──────────────────────┘  anonymous input type that has kind ❰Type → Type❱  \n\
        \       ⇧                                                                        \n\
        \       This is the kind of the input type                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \Other function inputs are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid, like this:                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────┐                                                            \n\
        \    │ ∀(x : 1) → x │  ❰1❱ is a “term” and not a “type” nor a “kind” so ❰x❱      \n\
        \    └──────────────┘  cannot have “type” ❰1❱ or “kind” ❰1❱                      \n\
        \            ⇧                                                                   \n\
        \            This is not a type or kind                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────┐                                                                \n\
        \    │ True → x │  ❰True❱ is a “term” and not a “type” nor a “kind” so the       \n\
        \    └──────────┘  anonymous input cannot have “type” ❰True❱ or “kind” ❰True❱    \n\
        \      ⇧                                                                         \n\
        \      This is not a type or kind                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \You annotated a function input with the following expression:                   \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is neither a type nor a kind                                          \n"
      where
        txt :: Doc Ann
txt = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

prettyTypeMessage (InvalidOutputType Expr s a
expr) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Invalid function output"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: A function can return an output “term” that has a given “type”,    \n\
        \like this:                                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ ∀(x : Text) → Bool │  This is the type of a function that returns an      \n\
        \    └────────────────────┘  output term that has type ❰Bool❱                    \n\
        \                    ⇧                                                           \n\
        \                    This is the type of the output term                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ Bool → Natural │  This is the type of a function that returns an output   \n\
        \    └────────────────┘  term that has type ❰Natural❱                            \n\
        \             ⇧                                                                  \n\
        \             This is the type of the output term                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \... or a function can return an output “type” that has a given “kind”, like     \n\
        \this:                                                                           \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ ∀(a : Type) → Type │  This is the type of a function that returns an      \n\
        \    └────────────────────┘  output type that has kind ❰Type❱                    \n\
        \                    ⇧                                                           \n\
        \                    This is the kind of the output type                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ (Type → Type) → Type │  This is the type of a function that returns an    \n\
        \    └──────────────────────┘  output type that has kind ❰Type❱                  \n\
        \                      ⇧                                                         \n\
        \                      This is the kind of the output type                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \Other outputs are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid, like this:                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ ∀(x : Bool) → x │  ❰x❱ is a “term” and not a “type” nor a “kind” so the   \n\
        \    └─────────────────┘  output cannot have “type” ❰x❱ or “kind” ❰x❱            \n\
        \                    ⇧                                                           \n\
        \                    This is not a type or kind                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────┐                                                             \n\
        \    │ Text → True │  ❰True❱ is a “term” and not a “type” nor a “kind” so the    \n\
        \    └─────────────┘  output cannot have “type” ❰True❱ or “kind” ❰True❱          \n\
        \             ⇧                                                                  \n\
        \             This is not a type or kind                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You use ❰∀❱ instead of ❰λ❱ by mistake, like this:                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ ∀(x: Bool) → x │                                                          \n\
        \    └────────────────┘                                                          \n\
        \      ⇧                                                                         \n\
        \      Using ❰λ❱ here instead of ❰∀❱ would transform this into a valid function  \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You specified that your function outputs a:                                     \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is neither a type nor a kind:                                         \n"
      where
        txt :: Doc Ann
txt = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

prettyTypeMessage (NotAFunction Expr s a
expr0 Expr s a
expr1) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Not a function"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Expressions separated by whitespace denote function application,   \n\
        \like this:                                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────┐                                                                     \n\
        \    │ f x │  This denotes the function ❰f❱ applied to an argument named ❰x❱     \n\
        \    └─────┘                                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \A function is a term that has type ❰a → b❱ for some ❰a❱ or ❰b❱.  For example,   \n\
        \the following expressions are all functions because they have a function type:  \n\
        \                                                                                \n\
        \                                                                                \n\
        \                        The function's input type is ❰Bool❱                     \n\
        \                        ⇩                                                       \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ λ(x : Bool) → x : Bool → Bool │  User-defined anonymous function          \n\
        \    └───────────────────────────────┘                                           \n\
        \                               ⇧                                                \n\
        \                               The function's output type is ❰Bool❱             \n\
        \                                                                                \n\
        \                                                                                \n\
        \                     The function's input type is ❰Natural❱                     \n\
        \                     ⇩                                                          \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ Natural/even : Natural → Bool │  Built-in function                        \n\
        \    └───────────────────────────────┘                                           \n\
        \                               ⇧                                                \n\
        \                               The function's output type is ❰Bool❱             \n\
        \                                                                                \n\
        \                                                                                \n\
        \                        The function's input kind is ❰Type❱                     \n\
        \                        ⇩                                                       \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ λ(a : Type) → a : Type → Type │  Type-level functions are still functions \n\
        \    └───────────────────────────────┘                                           \n\
        \                               ⇧                                                \n\
        \                               The function's output kind is ❰Type❱             \n\
        \                                                                                \n\
        \                                                                                \n\
        \             The function's input kind is ❰Type❱                                \n\
        \             ⇩                                                                  \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ List : Type → Type │  Built-in type-level function                        \n\
        \    └────────────────────┘                                                      \n\
        \                    ⇧                                                           \n\
        \                    The function's output kind is ❰Type❱                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \                        Function's input has kind ❰Type❱                        \n\
        \                        ⇩                                                       \n\
        \    ┌─────────────────────────────────────────────────┐                         \n\
        \    │ List/head : ∀(a : Type) → (List a → Optional a) │  A function can return  \n\
        \    └─────────────────────────────────────────────────┘  another function       \n\
        \                                ⇧                                               \n\
        \                                Function's output has type ❰List a → Optional a❱\n\
        \                                                                                \n\
        \                                                                                \n\
        \                       The function's input type is ❰List Text❱                 \n\
        \                       ⇩                                                        \n\
        \    ┌────────────────────────────────────────────┐                              \n\
        \    │ List/head Text : List Text → Optional Text │  A function applied to an    \n\
        \    └────────────────────────────────────────────┘  argument can be a function  \n\
        \                                   ⇧                                            \n\
        \                                   The function's output type is ❰Optional Text❱\n\
        \                                                                                \n\
        \                                                                                \n\
        \An expression is not a function if the expression's type is not of the form     \n\
        \❰a → b❱.  For example, these are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" functions:                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────┐                                                             \n\
        \    │ 1 : Natural │  ❰1❱ is not a function because ❰Natural❱ is not the type of \n\
        \    └─────────────┘  a function                                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ Natural/even 2 : Bool │  ❰Natural/even 2❱ is not a function because       \n\
        \    └───────────────────────┘  ❰Bool❱ is not the type of a function             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ List Text : Type │  ❰List Text❱ is not a function because ❰Type❱ is not   \n\
        \    └──────────────────┘  the type of a function                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You tried to add two ❰Natural❱s without a space around the ❰+❱, like this:    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────┐                                                                     \n\
        \    │ 2+2 │                                                                     \n\
        \    └─────┘                                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \  The above code is parsed as:                                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────┐                                                                  \n\
        \    │ 2 (+2) │                                                                  \n\
        \    └────────┘                                                                  \n\
        \      ⇧                                                                         \n\
        \      The compiler thinks that this ❰2❱ is a function whose argument is ❰+2❱    \n\
        \                                                                                \n\
        \                                                                                \n\
        \  This is because the ❰+❱ symbol has two meanings: you use ❰+❱ to add two       \n\
        \  numbers, but you also can prefix ❰Natural❱ literals with a ❰+❱ to turn them   \n\
        \  into ❰Integer❱ literals (like ❰+2❱)                                           \n\
        \                                                                                \n\
        \  To fix the code, you need to put spaces around the ❰+❱, like this:            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────┐                                                                   \n\
        \    │ 2 + 2 │                                                                   \n\
        \    └───────┘                                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to use the following expression as a function:                        \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but this expression's type is:                                              \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is not a function type                                                \n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (TypeMismatch Expr s a
expr0 Expr s a
expr1 Expr s a
expr2 Expr s a
expr3) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Wrong type of function argument\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
expr1 Expr s a
expr3)

    hints :: [Doc Ann]
hints = Expr s a -> [Doc Ann]
forall a s. (Eq a, Pretty a) => Expr s a -> [Doc Ann]
emptyRecordTypeHint Expr s a
expr2

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every function declares what type or kind of argument to accept    \n\
        \                                                                                \n\
        \For example:                                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ λ(x : Bool) → x : Bool → Bool │  This anonymous function only accepts     \n\
        \    └───────────────────────────────┘  arguments that have type ❰Bool❱          \n\
        \                        ⇧                                                       \n\
        \                        The function's input type                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ Natural/even : Natural → Bool │  This built-in function only accepts      \n\
        \    └───────────────────────────────┘  arguments that have type ❰Natural❱       \n\
        \                     ⇧                                                          \n\
        \                     The function's input type                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ λ(a : Type) → a : Type → Type │  This anonymous function only accepts     \n\
        \    └───────────────────────────────┘  arguments that have kind ❰Type❱          \n\
        \                        ⇧                                                       \n\
        \                        The function's input kind                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ List : Type → Type │  This built-in function only accepts arguments that  \n\
        \    └────────────────────┘  have kind ❰Type❱                                    \n\
        \             ⇧                                                                  \n\
        \             The function's input kind                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \For example, the following expressions are valid:                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ (λ(x : Bool) → x) True │  ❰True❱ has type ❰Bool❱, which matches the type  \n\
        \    └────────────────────────┘  of argument that the anonymous function accepts \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ Natural/even 2 │  ❰2❱ has type ❰Natural❱, which matches the type of       \n\
        \    └────────────────┘  argument that the ❰Natural/even❱ function accepts,      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ (λ(a : Type) → a) Bool │  ❰Bool❱ has kind ❰Type❱, which matches the kind  \n\
        \    └────────────────────────┘  of argument that the anonymous function accepts \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────┐                                                               \n\
        \    │ List Text │  ❰Text❱ has kind ❰Type❱, which matches the kind of argument   \n\
        \    └───────────┘  that that the ❰List❱ function accepts                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, you can " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" apply a function to the wrong type or kind of argument\n\
        \                                                                                \n\
        \For example, the following expressions are not valid:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ (λ(x : Bool) → x) \"A\" │  ❰\"A\"❱ has type ❰Text❱, but the anonymous function\n\
        \    └───────────────────────┘  expects an argument that has type ❰Bool❱         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ Natural/even \"A\" │  ❰\"A\"❱ has type ❰Text❱, but the ❰Natural/even❱ function\n\
        \    └──────────────────┘  expects an argument that has type ❰Natural❱           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ (λ(a : Type) → a) True │  ❰True❱ has type ❰Bool❱, but the anonymous       \n\
        \    └────────────────────────┘  function expects an argument of kind ❰Type❱     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────┐                                                                  \n\
        \    │ List 1 │  ❰1❱ has type ❰Natural❱, but the ❰List❱ function expects an      \n\
        \    └────────┘  argument that has kind ❰Type❱                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You omit a function argument by mistake:                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ List/head   [1, 2, 3] │                                                   \n\
        \    └───────────────────────┘                                                   \n\
        \                ⇧                                                               \n\
        \                ❰List/head❱ is missing the first argument,                      \n\
        \                which should be: ❰Natural❱                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You supply an ❰Integer❱ literal to a function that expects a ❰Natural❱        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ Natural/even +2 │                                                         \n\
        \    └─────────────────┘                                                         \n\
        \                   ⇧                                                            \n\
        \                   This should be ❰2❱                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to invoke the following function:                                     \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which expects an argument of type or kind:                                  \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... on the following argument:                                                  \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which has a different type or kind:                                         \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt3 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2
        txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr3

prettyTypeMessage (AnnotMismatch Expr s a
expr0 Expr s a
expr1 Expr s a
expr2) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Expression doesn't match annotation\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
expr1 Expr s a
expr2)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can annotate an expression with its type or kind using the     \n\
        \❰:❱ symbol, like this:                                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────┐                                                                   \n\
        \    │ x : t │  ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱\n\
        \    └───────┘                                                                   \n\
        \                                                                                \n\
        \The type checker verifies that the expression's type or kind matches the        \n\
        \provided annotation                                                             \n\
        \                                                                                \n\
        \For example, all of the following are valid annotations that the type checker   \n\
        \accepts:                                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────┐                                                             \n\
        \    │ 1 : Natural │  ❰1❱ is an expression that has type ❰Natural❱, so the type  \n\
        \    └─────────────┘  checker accepts the annotation                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ Natural/even 2 : Bool │  ❰Natural/even 2❱ has type ❰Bool❱, so the type    \n\
        \    └───────────────────────┘  checker accepts the annotation                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ List : Type → Type │  ❰List❱ is an expression that has kind ❰Type → Type❱,\n\
        \    └────────────────────┘  so the type checker accepts the annotation          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ List Text : Type │  ❰List Text❱ is an expression that has kind ❰Type❱, so \n\
        \    └──────────────────┘  the type checker accepts the annotation               \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, the following annotations are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid and the type checker will\n\
        \reject them:                                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────┐                                                                \n\
        \    │ 1 : Text │  The type checker rejects this because ❰1❱ does not have type  \n\
        \    └──────────┘  ❰Text❱                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────┐                                                             \n\
        \    │ List : Type │  ❰List❱ does not have kind ❰Type❱                           \n\
        \    └─────────────┘                                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● The Haskell Dhall interpreter implicitly inserts a top-level annotation       \n\
        \  matching the expected type                                                    \n\
        \                                                                                \n\
        \  For example, if you run the following Haskell code:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────┐                                           \n\
        \    │ >>> input auto \"1\" :: IO Text │                                         \n\
        \    └───────────────────────────────┘                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \  ... then the interpreter will actually type check the following annotated     \n\
        \  expression:                                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────┐                                                                \n\
        \    │ 1 : Text │                                                                \n\
        \    └──────────┘                                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \  ... and then type-checking will fail                                          \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You or the interpreter annotated this expression:                               \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... with this type or kind:                                                     \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but the inferred type or kind of the expression is actually:                \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2

prettyTypeMessage TypeMessage s a
Untyped = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"❰Sort❱ has no type, kind, or sort"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: There are five levels of expressions that form a hierarchy:        \n\
        \                                                                                \n\
        \● terms                                                                         \n\
        \● types                                                                         \n\
        \● kinds                                                                         \n\
        \● sorts                                                                         \n\
        \● orders                                                                        \n\
        \                                                                                \n\
        \The following example illustrates this hierarchy:                               \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────┐                                       \n\
        \    │ \"ABC\" : Text : Type : Kind : Sort │                                     \n\
        \    └───────────────────────────────────┘                                       \n\
        \       ⇧      ⇧      ⇧      ⇧      ⇧                                            \n\
        \       term   type   kind   sort   order                                        \n\
        \                                                                                \n\
        \There is nothing above ❰Sort❱ in this hierarchy, so if you try to type check any\n\
        \expression containing ❰Sort❱ anywhere in the expression then type checking fails\n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You supplied a sort where a kind was expected                                 \n\
        \                                                                                \n\
        \  For example, the following expression will fail to type check:                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ f : Type -> Kind │                                                        \n\
        \    └──────────────────┘                                                        \n\
        \                  ⇧                                                             \n\
        \                  ❰Kind❱ is a sort, not a kind                                  \n"

prettyTypeMessage (InvalidPredicate Expr s a
expr0 Expr s a
expr1) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Invalid predicate for ❰if❱: "
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
forall s a. Expr s a
Bool Expr s a
expr1)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\
        \❰Bool❱                                                                          \n\
        \                                                                                \n\
        \For example, these are valid ❰if❱ expressions:                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────┐                                            \n\
        \    │ if True then \"Yes\" else \"No\" │                                        \n\
        \    └──────────────────────────────┘                                            \n\
        \         ⇧                                                                      \n\
        \         Predicate                                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────┐                                 \n\
        \    │ λ(x : Bool) → if x then False else True │                                 \n\
        \    └─────────────────────────────────────────┘                                 \n\
        \                       ⇧                                                        \n\
        \                       Predicate                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but these are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid ❰if❱ expressions:                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────┐                                               \n\
        \    │ if 0 then \"Yes\" else \"No\" │  ❰0❱ does not have type ❰Bool❱            \n\
        \    └───────────────────────────┘                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────┐                                              \n\
        \    │ if \"\" then False else True │  ❰\"\"❱ does not have type ❰Bool❱          \n\
        \    └────────────────────────────┘                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You might be used to other programming languages that accept predicates other \n\
        \  than ❰Bool❱                                                                   \n\
        \                                                                                \n\
        \  For example, some languages permit ❰0❱ or ❰\"\"❱ as valid predicates and treat\n\
        \  them as equivalent to ❰False❱.  However, the Dhall language does not permit   \n\
        \  this                                                                          \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \Your ❰if❱ expression begins with the following predicate:                       \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... that has type:                                                              \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but the predicate must instead have type ❰Bool❱                             \n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (IfBranchMismatch Expr s a
expr0 Expr s a
expr1 Expr s a
expr2 Expr s a
expr3) =
    ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"❰if❱ branches must have matching types\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
expr1 Expr s a
expr3)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every ❰if❱ expression has a ❰then❱ and ❰else❱ branch, each of which\n\
        \is an expression:                                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \                   Expression for ❰then❱ branch                                 \n\
        \                   ⇩                                                            \n\
        \    ┌────────────────────────────────┐                                          \n\
        \    │ if True then \"Hello, world!\"   │                                        \n\
        \    │         else \"Goodbye, world!\" │                                        \n\
        \    └────────────────────────────────┘                                          \n\
        \                   ⇧                                                            \n\
        \                   Expression for ❰else❱ branch                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \These two expressions must have the same type.  For example, the following ❰if❱ \n\
        \expressions are all valid:                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ λ(b : Bool) → if b then 0 else 1 │ Both branches have type ❰Natural❱      \n\
        \    └──────────────────────────────────┘                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────┐                                              \n\
        \    │ λ(b : Bool) →              │                                              \n\
        \    │     if b then Natural/even │ Both branches have type ❰Natural → Bool❱     \n\
        \    │          else Natural/odd  │                                              \n\
        \    └────────────────────────────┘                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, the following expression is " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid:                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \                   This branch has type ❰Natural❱                               \n\
        \                   ⇩                                                            \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ if True then 0         │                                                  \n\
        \    │         else \"ABC\"     │                                                \n\
        \    └────────────────────────┘                                                  \n\
        \                   ⇧                                                            \n\
        \                   This branch has type ❰Text❱                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \The ❰then❱ and ❰else❱ branches must have matching types, even if the predicate  \n\
        \is always ❰True❱ or ❰False❱                                                     \n\
        \                                                                                \n\
        \Your ❰if❱ expression has the following ❰then❱ branch:                           \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which has type:                                                             \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... and the following ❰else❱ branch:                                            \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which has a different type:                                                 \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt3 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \Fix your ❰then❱ and ❰else❱ branches to have matching types                      \n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2
        txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr3

prettyTypeMessage (TypeMessage s a
ListLitInvariant) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Internal error: A non-empty list literal violated an internal invariant"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Internal error: A non-empty list literal violated an internal      \n\
        \invariant.                                                                      \n\
        \                                                                                \n\
        \A non-empty list literal must always be represented as                          \n\
        \                                                                                \n\
        \    ListLit Nothing [x, y, ...]                                                 \n\
        \                                                                                \n\
        \Please file a bug report at https://github.com/dhall-lang/dhall-haskell/issues, \n\
        \ideally including the offending source code.                                    \n"

prettyTypeMessage (InvalidListType Expr s a
expr0) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"Invalid type for ❰List❱"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: ❰List❱s can optionally document their type with a type annotation, \n\
        \like this:                                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────┐                                                \n\
        \    │ [1, 2, 3] : List Natural │  A ❰List❱ of three ❰Natural❱ numbers           \n\
        \    └──────────────────────────┘                                                \n\
        \                       ⇧                                                        \n\
        \                       The type of the ❰List❱'s elements, which are ❰Natural❱   \n\
        \                       numbers                                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────┐                                                       \n\
        \    │ [] : List Natural │  An empty ❰List❱                                      \n\
        \    └───────────────────┘                                                       \n\
        \           ⇧                                                                    \n\
        \           You must specify the type when the ❰List❱ is empty                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \The type must be of the form ❰List ...❱ and not something else.  For example,   \n\
        \the following type annotation is " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid:                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────┐                                                              \n\
        \    │ ... : Bool │                                                              \n\
        \    └────────────┘                                                              \n\
        \            ⇧                                                                   \n\
        \            This type does not have the form ❰List ...❱                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \The element type must be a type and not something else.  For example, the       \n\
        \following element types are " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" valid:                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────┐                                                            \n\
        \    │ ... : List 1 │                                                            \n\
        \    └──────────────┘                                                            \n\
        \                 ⇧                                                              \n\
        \                 This is a ❰Natural❱ number and not a ❰Type❱                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ ... : List Type │                                                         \n\
        \    └─────────────────┘                                                         \n\
        \                 ⇧                                                              \n\
        \                 This is a ❰Kind❱ and not a ❰Type❱                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \You declared that the ❰List❱ should have type:                                  \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is not a valid list type                                              \n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage TypeMessage s a
MissingListType =
    ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"An empty list requires a type annotation"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Lists do not require a type annotation if they have at least one   \n\
        \element:                                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────┐                                                               \n\
        \    │ [1, 2, 3] │  The compiler can infer that this list has type ❰List Natural❱\n\
        \    └───────────┘                                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, empty lists still require a type annotation:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────┐                                                       \n\
        \    │ [] : List Natural │  This type annotation is mandatory                    \n\
        \    └───────────────────┘                                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \You cannot supply an empty list without a type annotation                       \n"

prettyTypeMessage (MismatchedListElements Int
i Expr s a
expr0 Expr s a
_expr1 Expr s a
expr2) =
    ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"List elements should all have the same type\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
expr0 Expr s a
expr2)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every element in a list must have the same type                    \n\
        \                                                                                \n\
        \For example, this is a valid ❰List❱:                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────┐                                                               \n\
        \    │ [1, 2, 3] │  Every element in this ❰List❱ is a ❰Natural❱ number           \n\
        \    └───────────┘                                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \.. but this is " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" a valid ❰List❱:                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────┐                                                           \n\
        \    │ [1, \"ABC\", 3] │  The first and second element have different types      \n\
        \    └───────────────┘                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \Your first ❰List❱ element has this type:                                        \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but the element at index #" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" has this type instead:             \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt3 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc ann
txt1 = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
        txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2

prettyTypeMessage (InvalidListElement Int
i Expr s a
expr0 Expr s a
_expr1 Expr s a
expr2) =
    ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"List element has the wrong type\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
"\n"
        Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Diff -> Doc Ann
Dhall.Diff.doc (Expr s a -> Expr s a -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr s a
expr0 Expr s a
expr2)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every element in the list must have a type matching the type       \n\
        \annotation at the end of the list                                               \n\
        \                                                                                \n\
        \For example, this is a valid ❰List❱:                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────┐                                                \n\
        \    │ [1, 2, 3] : List Natural │  Every element in this ❰List❱ is an ❰Natural❱  \n\
        \    └──────────────────────────┘                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \.. but this is " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" a valid ❰List❱:                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────┐                                            \n\
        \    │ [1, \"ABC\", 3] : List Natural │  The second element is not an ❰Natural❱  \n\
        \    └──────────────────────────────┘                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \Your ❰List❱ elements should have this type:                                     \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but the element at index #" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" has this type instead:             \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt3 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt1 :: Doc ann
txt1 = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
        txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2

prettyTypeMessage (InvalidSome Expr s a
expr0 Expr s a
expr1 Expr s a
expr2) = ErrorMessages :: Doc Ann -> [Doc Ann] -> Doc Ann -> ErrorMessages
ErrorMessages {[Doc Ann]
Doc Ann
forall a. [a]
long :: Doc Ann
hints :: forall a. [a]
short :: Doc Ann
long :: Doc Ann
hints :: [Doc Ann]
short :: Doc Ann
..}
  where
    short :: Doc Ann
short = Doc Ann
"❰Some❱ argument has the wrong type"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰Some❱ constructor expects an argument that is a term, where   \n\
        \the type of the type of a term must be ❰Type❱                                   \n\
        \                                                                                \n\
        \For example, this is a valid use of ❰Some❱:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────┐                                                                  \n\
        \    │ Some 1 │  ❰1❱ is a valid term because ❰1 : Natural : Type❱                \n\
        \    └────────┘                                                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but this is " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
_NOT Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" a valid ❰Optional❱ value:                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────┐                                                               \n\
        \    │ Some Text │  ❰Text❱ is not a valid term because ❰Text : Type : Kind ❱     \n\
        \    └───────────┘                                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \The ❰Some❱ argument you provided:                                               \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... has this type:                                                              \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... but the type of that type is:                                               \n\
        \                                                                                \n\
        \"