{-# 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\
        \" 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 is not ❰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
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2

prettyTypeMessage (InvalidFieldType Text
k 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 field type"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every record type annotates each field with a ❰Type❱, a ❰Kind❱, or \n\
        \a ❰Sort❱ like this:                                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────────┐                            \n\
        \    │ { foo : Natural, bar : Integer, baz : Text } │  Every field is annotated  \n\
        \    └──────────────────────────────────────────────┘  with a ❰Type❱             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────┐                                              \n\
        \    │ { foo : Type, bar : Type } │  Every field is annotated                    \n\
        \    └────────────────────────────┘  with a ❰Kind❱                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, the types of fields may " 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
" be term-level values:           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────┐                                              \n\
        \    │ { foo : Natural, bar : 1 } │  Invalid record type                         \n\
        \    └────────────────────────────┘                                              \n\
        \                             ⇧                                                  \n\
        \                             ❰1❱ is a ❰Natural❱ number and not a ❰Type❱,        \n\
        \                             ❰Kind❱, or ❰Sort❱                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \You provided a record type with a field named:                                  \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\
        \... annotated with the following expression:                                    \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 neither a ❰Type❱, a ❰Kind❱, nor a ❰Sort❱                           \n"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage (InvalidAlternativeType Text
k 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 alternative type"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Every union type specifies the type of each alternative, like this:\n\
        \                                                                                \n\
        \                                                                                \n\
        \               The type of the first alternative is ❰Bool❱                      \n\
        \               ⇩                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ < Left : Bool, Right : Natural > │  A union type with two alternatives    \n\
        \    └──────────────────────────────────┘                                        \n\
        \                             ⇧                                                  \n\
        \                             The type of the second alternative is ❰Natural❱    \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, these alternatives can only be annotated with ❰Type❱s, ❰Kind❱s, or     \n\
        \❰Sort❱s.  For example, the following union 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\
        \    │ < Left : Bool, Right : 1 > │  Invalid union type                          \n\
        \    └────────────────────────────┘                                              \n\
        \                             ⇧                                                  \n\
        \                             This is a ❰Natural❱ and not a ❰Type❱, ❰Kind❱, or   \n\
        \                             ❰Sort❱                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You accidentally typed ❰:❱ instead of ❰=❱ for a union literal with one        \n\
        \  alternative:                                                                  \n\
        \                                                                                \n\
        \    ┌─────────────────┐                                                         \n\
        \    │ < Example : 1 > │                                                         \n\
        \    └─────────────────┘                                                         \n\
        \                ⇧                                                               \n\
        \                This could be ❰=❱ instead                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided a union type with an alternative named:                            \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\
        \... annotated with the following expression which is not a ❰Type❱, ❰Kind❱, or   \n\
        \❰Sort❱:                                                                         \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage (ListAppendMismatch 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
"You can only append ❰List❱s with matching element 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
expr0 Expr s a
expr1)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can append two ❰List❱s using the ❰#❱ operator, like this:      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ [1, 2, 3] # [4, 5] │                                                      \n\
        \    └────────────────────┘                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot append two ❰List❱s if they have different element types.     \n\
        \For example, 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\
        \       These elements have type ❰Natural❱                                       \n\
        \       ⇩                                                                        \n\
        \    ┌───────────────────────────┐                                               \n\
        \    │ [1, 2, 3] # [True, False] │  Invalid: the element types don't match       \n\
        \    └───────────────────────────┘                                               \n\
        \                  ⇧                                                             \n\
        \                  These elements have type ❰Bool❱                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to append a ❰List❱ thas has elements of 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\
        \... with another ❰List❱ that has elements of 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\
        \... and those two types do not match                                            \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 (CompletionSchemaMustBeARecord 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
"The completion schema must be a record"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can complete records using the ❰::❱ operator:                  \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────────┐ \n\
        \    │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\
        \    └─────────────────────────────────────────────────────────────────────────┘ \n\
        \                                                                                \n\
        \... The left-hand side of :: must be a record with 'Type' and 'default' keys    \n\
        \                                                                                \n\
        \You tried to record complete the following value:                               \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 record. It 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"
      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 (InvalidRecordCompletion Text
fieldName Expr s a
expr0) = 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
..}
  where
    short :: Doc ann
short = Doc ann
"Completion schema is missing a field: " 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 Text
fieldName

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can complete records using the ❰::❱ operator like this:\n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────────┐ \n\
        \    │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\
        \    └─────────────────────────────────────────────────────────────────────────┘ \n\
        \                                                                                \n\
        \... but you need to have both Type and default fields in the completion schema  \n\
        \    (the record on the left of the the ::).                                     \n\
        \                                                                                \n\
        \You tried to do record completion using the schema:                             \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 missing the key:                                                   \n\
        \                                                                                \n\
        \" 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
"\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 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
fieldName

prettyTypeMessage (MustUpdateARecord Expr s a
withExpression Expr s a
expression Expr s a
typeExpression) =
    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
"You can only update records"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can update records using the ❰with❱ keyword, like this:        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────┐                                          \n\
        \    │ { x = { y = 1 } } with x.y = 2 │                                          \n\
        \    └────────────────────────────────┘                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────────────────────┐              \n\
        \    │ λ(r : { foo : { bar : Bool } }) → r with foo.bar = False } │              \n\
        \    └────────────────────────────────────────────────────────────┘              \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot update values that are not records.                          \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌─────────────────┐                                                         \n\
        \    │ 1 with x = True │                                                         \n\
        \    └─────────────────┘                                                         \n\
        \      ⇧                                                                         \n\
        \      Invalid: Not a record                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \The following expression is not permitted:                                      \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
withExpression' Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... because the left argument to ❰with❱:                                        \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expression Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... is not a record, but is actually a:                                         \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
typeExpression Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        withExpression' :: Expr s a
withExpression' = case Expr s a
withExpression of
            With Expr s a
record NonEmpty WithComponent
keys Expr s a
value -> Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With (Expr s a -> Expr s a
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr s a
record) NonEmpty WithComponent
keys Expr s a
value
            Expr s a
_                      -> Expr s a
withExpression

prettyTypeMessage (MustCombineARecord Char
c Expr s a
expression Expr s a
typeExpression) =
    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
    action :: Doc Ann
action = case Char
c of
        Char
'∧' -> Doc Ann
"combine"
        Char
_   -> Doc Ann
"override"

    short :: Doc Ann
short = Doc Ann
"You can only " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
action Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" records"

    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
expression

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
action Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" records using the ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱ operator, like this:\n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────┐                               \n\
        \    │ { foo = 1, bar = \"ABC\" } " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" { baz = True } │                  \n\
        \    └───────────────────────────────────────────┘                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────┐                             \n\
        \    │ λ(r : { foo : Bool }) → r " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" { bar = \"ABC\" } │                \n\
        \    └─────────────────────────────────────────────┘                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
action Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" values that are not records.                \n\
        \                                                                                \n\
        \For example, the following expressions 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\
        \    │ { foo = 1, bar = \"ABC\" } " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" 1 │                               \n\
        \    └──────────────────────────────┘                                            \n\
        \                                 ⇧                                              \n\
        \                                 Invalid: Not a record                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────┐                               \n\
        \    │ { foo = 1, bar = \"ABC\" } " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" { baz : Bool } │                  \n\
        \    └───────────────────────────────────────────┘                               \n\
        \                                 ⇧                                              \n\
        \                                 Invalid: This is a record type and not a record\n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────┐                               \n\
        \    │ { foo = 1, bar = \"ABC\" } " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
op Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" < baz : Bool > │                  \n\
        \    └───────────────────────────────────────────┘                               \n\
        \                                 ⇧                                              \n\
        \                                 Invalid: This is a union type and not a record \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You supplied this expression as one of the arguments:                           \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expression Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is not a record, but is actually a:                                   \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
typeExpression Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
      where
        op :: Doc ann
op = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c

prettyTypeMessage (InvalidDuplicateField Text
k 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 duplicate field: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can specify a field twice if both fields are themselves        \n\
        \records, like this:                                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────────────────────┐                \n\
        \    │ { ssh = { enable = True }, ssh = { forwardX11 = True } } │                \n\
        \    └──────────────────────────────────────────────────────────┘                \n\
        \                                                                                \n\
        \                                                                                \n\
        \... because the language automatically merges two occurrences of a field using  \n\
        \the ❰∧❱ operator, and the above example is equivalent to:                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────┐                     \n\
        \    │ { ssh = { enable = True } ∧ { forwardX11 = True } } │                     \n\
        \    └─────────────────────────────────────────────────────┘                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... which is in turn equivalent to:                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────────┐                          \n\
        \    │ { ssh = { enable = True, forwardX11 = True } } │                          \n\
        \    └────────────────────────────────────────────────┘                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, this implies that both fields must be records since the ❰∧❱ operator   \n\
        \cannot merge non-record values.  For example, these expressions are not valid:  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ { x = 0, x = 0 } │  Invalid: Neither field is a record                    \n\
        \    └──────────────────┘                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────┐                                                \n\
        \    │ { x = 0, x = { y = 0 } } │  Invalid: The first ❰x❱ field is not a record  \n\
        \    └──────────────────────────┘                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You specified more than one field named:                                        \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 one of the fields had this value:                                       \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\
        \... with this 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\
        \... which is not a record type                                                  \n"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (Bool -> Text -> Text
Dhall.Pretty.Internal.escapeLabel Bool
True Text
k)
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (CombineTypesRequiresRecordType 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
"❰⩓❱ requires arguments that are record types"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only use the ❰⩓❱ operator on arguments that are record type\n\
        \literals, like this:                                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────┐                                     \n\
        \    │ { age : Natural } ⩓ { name : Text } │                                     \n\
        \    └─────────────────────────────────────┘                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot use the ❰⩓❱ operator on any other type of arguments.  For    \n\
        \example, you cannot use variable arguments:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────┐                                       \n\
        \    │ λ(t : Type) → t ⩓ { name : Text } │  Invalid: ❰t❱ might not be a record   \n\
        \    └───────────────────────────────────┘  type                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to supply the following argument:                                     \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 normalized to:                                                        \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 record type literal                                          \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 (RecordTypeMismatch Const
const0 Const
const1 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
"Record type mismatch"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only use the ❰⩓❱ operator on record types if they are both \n\
        \ ❰Type❱s or ❰Kind❱s:                                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────┐                                     \n\
        \    │ { age : Natural } ⩓ { name : Text } │  Valid: Both arguments are ❰Type❱s  \n\
        \    └─────────────────────────────────────┘                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────┐                                    \n\
        \    │ { Input : Type } ⩓ { Output : Type } │  Valid: Both arguments are ❰Kind❱s \n\
        \    └──────────────────────────────────────┘                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot combine a ❰Type❱ and a ❰Kind❱:                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────┐                                      \n\
        \    │ { Input : Type } ⩓ { name : Text } │  Invalid: The arguments do not match \n\
        \    └────────────────────────────────────┘                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to combine the following record 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\
        \... with this record types:                                                     \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 former record type is a:                                            \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\
        \... but the latter record type is a:                                            \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 = Const -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Const
const0
        txt3 :: Doc Ann
txt3 = Const -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Const
const1

prettyTypeMessage (DuplicateFieldCannotBeMerged NonEmpty Text
ks) = 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
..}
  where
    short :: Doc ann
short = Doc ann
"Duplicate field cannot be merged: " 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 (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Duplicate fields are only allowed if they are both records and if  \n\
        \the two records can be recursively merged without collisions.                   \n\
        \                                                                                \n\
        \Specifically, an expression like:                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ { x = a, x = b } │                                                        \n\
        \    └──────────────────┘                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \... is syntactic sugar for:                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────┐                                                           \n\
        \    │ { x = a ∧ b } │                                                           \n\
        \    └───────────────┘                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \... which is rejected if ❰a ∧ b❱ does not type-check.  One way this can happen  \n\
        \is if ❰a❱ and ❰b❱ share a field in common that is not a record, which is known  \n\
        \as a \"collision\".                                                               \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ { x = { y = 0 }, x = { y = 1 } } │ Invalid: The two ❰x.y❱ fields \"collide\"\n\
        \    └──────────────────────────────────┘                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \... whereas the following expression is valid:                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ { x = { y = 0 }, x = { z = 1 } } │ Valid: the two ❰x❱ fields don't collide\n\
        \    └──────────────────────────────────┘ because they can be recursively merged \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You specified the same field twice by mistake                                 \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You specified the following field twice:                                        \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 collided on the following path:                                       \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (Bool -> Text -> Text
Dhall.Pretty.Internal.escapeLabel Bool
True (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Text
ks))

        txt1 :: Doc Ann
txt1 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

prettyTypeMessage (FieldCollision NonEmpty Text
ks) = 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
..}
  where
    short :: Doc ann
short = Doc ann
"Field collision on: " 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 (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can recursively merge records using the ❰∧❱ operator:          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ { x = a } ∧ { y = b } │                                                   \n\
        \    └───────────────────────┘                                                   \n\
        \                                                                                \n\
        \... but two records cannot be merged in this way if they share a field that is  \n\
        \not a record.                                                                   \n\
        \                                                                                \n\
        \For example, the following expressions 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\
        \    │ { x = 1 } ∧ { x = True } │  Invalid: The ❰x❱ fields \"collide\" because they\n\
        \    └──────────────────────────┘  are not records that can be merged            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ { x = 1 } ∧ { x = { y = True } } │  Invalid: One of the two ❰x❱ fields is \n\
        \    └──────────────────────────────────┘  still not a record                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the following expression is valid:                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────┐  Valid: The two ❰x❱ fields     \n\
        \    │ { x = { y = True } } ∧ { x = { z = 1 } } │  don't collide because they can\n\
        \    └──────────────────────────────────────────┘  be recursively merged         \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You tried to use ❰∧❱ to update a field's value, like this:                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────┐                                  \n\
        \    │ { foo = 1, bar = \"ABC\" } ∧ { foo = 2 } │                                  \n\
        \    └────────────────────────────────────────┘                                  \n\
        \                                   ⇧                                            \n\
        \                                  Invalid attempt to update ❰foo❱'s value to ❰2❱\n\
        \                                                                                \n\
        \                                                                                \n\
        \  You probably meant to use ❰⫽❱ / ❰//❱  instead:                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────┐                                  \n\
        \    │ { foo = 1, bar = \"ABC\" } ⫽ { foo = 2 } │                                  \n\
        \    └────────────────────────────────────────┘                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to merge two records which collided on the following path:            \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

prettyTypeMessage (FieldTypeCollision NonEmpty Text
ks) = 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
..}
  where
    short :: Doc ann
short = Doc ann
"Field type collision on: " 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 (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can recursively merge record types using the ❰⩓❱ operator, like\n\
        \this:                                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ { x : A } ⩓ { y : B } │                                                   \n\
        \    └───────────────────────┘                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot merge record types if two field types collide that are not   \n\
        \both record types.                                                              \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌────────────────────────────────┐                                          \n\
        \    │ { x : Natural } ⩓ { x : Bool } │  Invalid: The ❰x❱ fields \"collide\"       \n\
        \    └────────────────────────────────┘  because they cannot be merged           \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the following expression is valid:                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────────┐  Valid: The ❰x❱ field    \n\
        \    │ { x : { y : Bool } } ⩓ { x : { z : Natural } } │  types don't collide and \n\
        \    └────────────────────────────────────────────────┘  can be merged           \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to merge two record types which collided on the following path:       \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (NonEmpty Text -> Text
forall (list :: * -> *).
(Functor list, Foldable list) =>
list Text -> Text
toPath NonEmpty Text
ks)

prettyTypeMessage (MustMergeARecord 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
"❰merge❱ expects a record of handlers"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │     let union    = < Left : Natural | Right : Bool >.Left 2         │     \n\
        \    │ in  let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │     \n\
        \    │ in  merge handlers union                                            │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the first argument to ❰merge❱ must be a record and not some other type. \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌─────────────────────────────────────────────┐                             \n\
        \    │ let handler = λ(x : Bool) → x               │                             \n\
        \    │ in  merge handler (< Foo : Bool >.Foo True) │                             \n\
        \    └─────────────────────────────────────────────┘                             \n\
        \                ⇧                                                               \n\
        \                Invalid: ❰handler❱ isn't a record                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You accidentally provide an empty record type instead of an empty record when \n\
        \  you ❰merge❱ an empty union:                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ λ(x : <>) → λ(a : Type) → merge {} x : a │                                \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                                      ⇧                                         \n\
        \                                      This should be ❰{=}❱ instead              \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided the following handler:                                             \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 record, but is actually a value of 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"
      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 (MustMergeUnionOrOptional 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
"❰merge❱ expects a union or an ❰Optional❱"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... or this:                                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────┐                 \n\
        \    │ let optional = None Bool                                │                 \n\
        \    │ let handlers = { None = False, Some = λ(x : Bool) → x } │                 \n\
        \    │ in  merge handlers optional                             │                 \n\
        \    └─────────────────────────────────────────────────────────┘                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the second argument to ❰merge❱ must not be some other type.             \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ let handlers = { Foo = λ(x : Bool) → x } │                                \n\
        \    │ in  merge handlers True                  │                                \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                         ⇧                                                      \n\
        \                         Invalid: ❰True❱ isn't a union or an ❰Optional❱         \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to ❰merge❱ 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\
        \... which is not a union or an ❰Optional❱, but is actually a value of 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"
      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 (UnusedHandler Set Text
ks) = 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
"Unused handler"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you must provide exactly one handler per alternative in the union.  You \n\
        \cannot supply extra handlers                                                    \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ let union    = < Left : Natural >.Left 2 │  The ❰Right❱ alternative is    \n\
        \    │ let handlers =                           │  missing                       \n\
        \    │             { Left  = Natural/even       │                                \n\
        \    │             , Right = λ(x : Bool) → x    │  Invalid: ❰Right❱ handler isn't\n\
        \    │             }                            │           used                 \n\
        \    │ in  merge handlers union                 │                                \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \You provided the following handlers:                                            \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 had no matching alternatives in the union you tried to ❰merge❱        \n"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (Text -> [Text] -> Text
Text.intercalate Text
", " (Set Text -> [Text]
forall a. Set a -> [a]
Data.Set.toList Set Text
ks))

prettyTypeMessage (MissingHandler Text
exemplar Set Text
ks) = 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 = case Set Text -> [Text]
forall a. Set a -> [a]
Data.Set.toList Set Text
ks of
         []       -> Doc Ann
"Missing handler: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
exemplar
         xs :: [Text]
xs@(Text
_:[Text]
_) -> Doc Ann
"Missing handlers: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> ([Doc Ann] -> Doc Ann
forall ann. [Doc ann] -> Doc ann
Pretty.hsep ([Doc Ann] -> Doc Ann)
-> ([Text] -> [Doc Ann]) -> [Text] -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> [Doc Ann] -> [Doc Ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
Pretty.punctuate Doc Ann
forall ann. Doc ann
Pretty.comma
                                             ([Doc Ann] -> [Doc Ann])
-> ([Text] -> [Doc Ann]) -> [Text] -> [Doc Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Ann) -> [Text] -> [Doc Ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel ([Text] -> Doc Ann) -> [Text] -> Doc Ann
forall a b. (a -> b) -> a -> b
$ Text
exemplarText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you must provide exactly one handler per alternative in the union.  You \n\
        \cannot omit any handlers                                                        \n\
        \                                                                                \n\
        \For example, 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\
        \                                          Invalid: Missing ❰Right❱ handler      \n\
        \                                          ⇩                                     \n\
        \    ┌──────────────────────────────────────────────────────────────┐            \n\
        \    │ let handlers = { Left = Natural/even }                       │            \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2      │            \n\
        \    │ in  merge handlers union                                     │            \n\
        \    └──────────────────────────────────────────────────────────────┘            \n\
        \                                                                                \n\
        \                                                                                \n\
        \Note that you need to provide handlers for other alternatives even if those     \n\
        \alternatives are never used                                                     \n\
        \                                                                                \n\
        \You need to supply the following handlers:                                      \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (Text -> [Text] -> Text
Text.intercalate Text
", " (Text
exemplar Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Set Text -> [Text]
forall a. Set a -> [a]
Data.Set.toList Set Text
ks))

prettyTypeMessage TypeMessage s a
MissingMergeType =
    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 ❰merge❱ requires a type annotation"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: A ❰merge❱ does not require a type annotation if the union has at   \n\
        \least one alternative, like this                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, you must provide a type annotation when merging an empty union:        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────┐                                          \n\
        \    │ λ(a : <>) → merge {=} a : Bool │                                          \n\
        \    └────────────────────────────────┘                                          \n\
        \                                ⇧                                               \n\
        \                                This can be any type                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \You can provide any type at all as the annotation, since merging an empty       \n\
        \union can produce any type of output                                            \n"

prettyTypeMessage (HandlerInputTypeMismatch Text
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
"Wrong handler input 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
expr1 Expr s a
expr2)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... as long as the input type of each handler function matches the type of the  \n\
        \corresponding alternative:                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────────────────────┐               \n\
        \    │ union    : < Left : Natural       | Right : Bool        > │               \n\
        \    └───────────────────────────────────────────────────────────┘               \n\
        \                          ⇧                       ⇧                             \n\
        \                   These must match        These must match                     \n\
        \                          ⇩                       ⇩                             \n\
        \    ┌───────────────────────────────────────────────────────────┐               \n\
        \    │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │               \n\
        \    └───────────────────────────────────────────────────────────┘               \n\
        \                                                                                \n\
        \                                                                                \n\
        \For example, 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\
        \      Invalid: Doesn't match the type of the ❰Right❱ alternative                \n\
        \                                                               ⇩                \n\
        \    ┌──────────────────────────────────────────────────────────────────┐        \n\
        \    │ let handlers = { Left = Natural/even | Right = λ(x : Text) → x } │        \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2          │        \n\
        \    │ in  merge handlers union                                         │        \n\
        \    └──────────────────────────────────────────────────────────────────┘        \n\
        \                                                                                \n\
        \                                                                                \n\
        \Your handler for the following alternative:                                     \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\
        \... needs to accept an input value of 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 actually accepts an input value of a different 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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
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 (DisallowedHandlerType Text
label Expr s a
handlerType Expr s a
handlerOutputType Text
variable) =
    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
"Disallowed handler type"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the output type of a handler may not depend on the input value.         \n\
        \                                                                                \n\
        \For example, 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\
        \      Invalid: The output type is ❰Optional A❱, which references the input      \n\
        \      value ❰A❱.                                                                \n\
        \                  ⇩                                                             \n\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ merge { x = None } (< x : Type >.x Bool) │                                \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \Your handler for the following alternative:                                     \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
label Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... has type:                                                                   \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
handlerType Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... where the output type:                                                      \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
handlerOutputType Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... references the handler's input value:                                       \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
variable Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"

prettyTypeMessage (InvalidHandlerOutputType Text
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
"Wrong handler output 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
expr1 Expr s a
expr2)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union : Bool                                 │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... as long as the output type of each handler function matches the declared    \n\
        \type of the result:                                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────────────────────┐               \n\
        \    │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │               \n\
        \    └───────────────────────────────────────────────────────────┘               \n\
        \                                    ⇧                    ⇧                      \n\
        \                                    These output types ...                      \n\
        \                                                                                \n\
        \                             ... must match the declared type of the ❰merge❱    \n\
        \                             ⇩                                                  \n\
        \    ┌─────────────────────────────┐                                             \n\
        \    │ merge handlers union : Bool │                                             \n\
        \    └─────────────────────────────┘                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌──────────────────────────────────────────────────────────────────┐        \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2          │        \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x }  │        \n\
        \    │ in  merge handlers union : Text                                  │        \n\
        \    └──────────────────────────────────────────────────────────────────┘        \n\
        \                                 ⇧                                              \n\
        \                                 Invalid: Doesn't match output of either handler\n\
        \                                                                                \n\
        \                                                                                \n\
        \Your handler for the following alternative:                                     \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\
        \... needs to return an output value of 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 actually returns an output value of a different 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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
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 (HandlerOutputTypeMismatch Text
key0 Expr s a
expr0 Text
key1 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
"Handlers should have the same output 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
expr1)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... as long as the output type of each handler function is the same:            \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────────────────────┐               \n\
        \    │ handlers : { Left : Natural → Bool, Right : Bool → Bool } │               \n\
        \    └───────────────────────────────────────────────────────────┘               \n\
        \                                    ⇧                    ⇧                      \n\
        \                                These output types both match                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌─────────────────────────────────────────────────┐                         \n\
        \    │ let Union = < Left : Natural | Right : Bool >   │                         \n\
        \    │ let handlers =                                  │                         \n\
        \    │              { Left  = λ(x : Natural) → x       │  This outputs ❰Natural❱ \n\
        \    │              , Right = λ(x : Bool   ) → x       │  This outputs ❰Bool❱    \n\
        \    │              }                                  │                         \n\
        \    │ in  merge handlers (Union.Left 2)               │                         \n\
        \    └─────────────────────────────────────────────────┘                         \n\
        \                ⇧                                                               \n\
        \                Invalid: The handlers in this record don't have matching outputs\n\
        \                                                                                \n\
        \                                                                                \n\
        \The handler for the ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt0 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱ alternative has this output 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 handler for the ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱ alternative has this output 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 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
key0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt2 :: Doc ann
txt2 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
key1
        txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (HandlerNotAFunction Text
k 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
"Handler for "Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" is not a function"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can ❰merge❱ the alternatives of a union or an ❰Optional❱ using \n\
        \a record with one handler per alternative, like this:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────┐         \n\
        \    │ let union    = < Left : Natural | Right : Bool >.Left 2         │         \n\
        \    │ let handlers = { Left = Natural/even, Right = λ(x : Bool) → x } │         \n\
        \    │ in  merge handlers union                                        │         \n\
        \    └─────────────────────────────────────────────────────────────────┘         \n\
        \                                                                                \n\
        \                                                                                \n\
        \... as long as each handler is a function -- FIXME                              \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌────────────────────────────────────────────────┐                          \n\
        \    │ merge { Foo = True } (< Foo : Natural >.Foo 1) │                          \n\
        \    └────────────────────────────────────────────────┘                          \n\
        \                    ⇧                                                           \n\
        \                    Invalid: Not a function                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \Your handler for this alternative:                                              \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 the following 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\
        \... which is not the type of a function                                         \n"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage (MustMapARecord Expr s a
provided Expr s a
_providedType) = 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
"❰toMap❱ expects a record value"

    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
provided

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can apply ❰toMap❱ to any homogenous record, like this:         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ let record = { one = 1, two = 2 }                                   │     \n\
        \    │ in  toMap record : List { mapKey : Text, mapValue : Natural}        │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the argument to ❰toMap❱ must be a record and not some other type.       \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You accidentally provide an empty record type instead of an empty record when \n\
        \  using ❰toMap❱:                                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────────────────┐                   \n\
        \    │ toMap {} : List { mapKey : Text, mapValue : Natural } │                   \n\
        \    └───────────────────────────────────────────────────────┘                   \n\
        \            ⇧                                                                   \n\
        \            This should be ❰{=}❱ instead                                        \n"

prettyTypeMessage (InvalidToMapRecordKind Expr s a
type_ Expr s a
kind) = 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
"❰toMap❱ expects a record of kind ❰Type❱"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can apply ❰toMap❱ to any homogenous record of kind ❰Type❱, like\n\
        \ this:                                                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ let record = { one = 1, two = 2 }                                   │     \n\
        \    │ in  toMap record : List { mapKey : Text, mapValue : Natural}        │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but records of kind ❰Kind❱ or ❰Sort❱ cannot be turned into ❰List❱s.         \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You applied ❰toMap❱ to a record of the following type:                          \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
type_ Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which has kind                                                              \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
kind Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"

prettyTypeMessage (HeterogenousRecordToMap 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]
forall ann. Doc ann
long :: forall ann. 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
"❰toMap❱ expects a homogenous record"

    hints :: [a]
hints = []

    long :: Doc ann
long =
        Doc ann
"Explanation: You can apply ❰toMap❱ to any homogenous record, like this:         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ let record = { one = 1, two = 2 }                                   │     \n\
        \    │ in  toMap record : List { mapKey : Text, mapValue : Natural}        │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but every field of the record must have the same type.                      \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌─────────────────────────────────────────┐                                 \n\
        \    │ toMap { Foo = True, Bar = 0 }           │                                 \n\
        \    └─────────────────────────────────────────┘                                 \n\
        \                    ⇧           ⇧                                               \n\
        \                    Bool        Natural                                         \n"

prettyTypeMessage (MapTypeMismatch 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
"❰toMap❱ result type doesn't match annotation"
        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
expr1)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: a ❰toMap❱ application has been annotated with a type that doesn't  \n\
        \match its inferred type.                                                        \n"

prettyTypeMessage (InvalidToMapType 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
"An empty ❰toMap❱ was annotated with an invalid type"
        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
<>  Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: A ❰toMap❱ applied to an empty record must have a type annotation:  \n\
        \that matches a list of key-value pairs, like this                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ toMap {=} : List { mapKey : Text, mapValue : Natural}               │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \The type you have provided doesn't match the expected form.                     \n\
        \                                                                                \n"

prettyTypeMessage TypeMessage s a
MissingToMapType =
    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 ❰toMap❱ requires a type annotation"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: A ❰toMap❱ does not require a type annotation if the record has at  \n\
        \least one field, like this                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ let record = { one = 1, two = 2 }                                   │     \n\
        \    │ in  toMap record                                                    │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, you must provide a type annotation with an empty record:               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────────────────────┐     \n\
        \    │ toMap {=} : List { mapKey : Text, mapValue : Natural}               │     \n\
        \    └─────────────────────────────────────────────────────────────────────┘     \n\
        \                                                                                \n"

prettyTypeMessage (CantAccess Text
lazyText0 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 record or a union"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only access fields on records or unions, like this:        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ { foo = True, bar = \"ABC\" }.foo │  This is valid ...                    \n\
        \    └─────────────────────────────────┘                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────┐                               \n\
        \    │ λ(r : { foo : Bool, bar : Text }) → r.foo │  ... and so is this           \n\
        \    └───────────────────────────────────────────┘                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ < foo : Bool | bar : Text >.foo │  ... and so is this                     \n\
        \    └─────────────────────────────────┘                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────┐                              \n\
        \    │ λ(r : < foo : Bool | bar : Text >) → r.foo │  ... and so is this          \n\
        \    └────────────────────────────────────────────┘                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot access fields on non-record expressions                      \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌───────┐                                                                   \n\
        \    │ 1.foo │                                                                   \n\
        \    └───────┘                                                                   \n\
        \      ⇧                                                                         \n\
        \      Invalid: Not a record                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to access the field:                                                  \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\
        \... on the following expression which is not a record nor a union 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 is actually an expression of 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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
lazyText0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (CantProject Text
lazyText0 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 record"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only project fields on records, like this:                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────────────┐                     \n\
        \    │ { foo = True, bar = \"ABC\", baz = 1 }.{ foo, bar } │  This is valid ...  \n\
        \    └─────────────────────────────────────────────────────┘                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────────────────────────────────────┐      \n\
        \    │ λ(r : { foo : Bool, bar : Text , baz : Natural }) → r.{ foo, bar } │  ... and so is this           \n\
        \    └────────────────────────────────────────────────────────────────────┘      \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot project fields on non-record expressions                     \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌────────────────┐                                                          \n\
        \    │ 1.{ foo, bar } │                                                          \n\
        \    └────────────────┘                                                          \n\
        \      ⇧                                                                         \n\
        \      Invalid: Not a record                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You accidentally try to project fields of a union instead of a record, like   \n\
        \  this:                                                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────────┐                                      \n\
        \    │ < foo : a | bar : b >.{ foo, bar } │                                      \n\
        \    └────────────────────────────────────┘                                      \n\
        \      ⇧                                                                         \n\
        \      This is a union, not a record                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to access the fields:                                                 \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\
        \... on the following expression which is not a record:                          \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 is actually an expression of 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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
lazyText0
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (CantProjectByExpression 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
"Selector is not a record type"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can project by an expression if that expression is a record    \n\
        \type:                                                                           \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ { foo = True }.({ foo : Bool }) │  This is valid ...                      \n\
        \    └─────────────────────────────────┘                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ λ(r : { foo : Bool }) → r.{ foo : Bool } │  ... and so is this            \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot project by any other type of expression:                     \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌───────────────────────┐                                                   \n\
        \    │ { foo = True }.(True) │                                                   \n\
        \    └───────────────────────┘                                                   \n\
        \                      ⇧                                                         \n\
        \                      Invalid: Not a record type                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You accidentally try to project by a record value instead of a record type,   \n\
        \  like this:                                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ let T = { foo : Bool }          │                                         \n\
        \    │                                 │                                         \n\
        \    │ let x = { foo = True , bar = 1} │                                         \n\
        \    │                                 │                                         \n\
        \    │ let y = { foo = False, bar = 2} │                                         \n\
        \    │                                 │                                         \n\
        \    │ in  x.(y)                       │                                         \n\
        \    └─────────────────────────────────┘                                         \n\
        \             ⇧                                                                  \n\
        \             The user might have meant ❰T❱ here                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to project out the following type:                                    \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 not a record type                                                  \n"
      where
        txt :: Doc Ann
txt = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

prettyTypeMessage (DuplicateProjectionLabel Text
k) = 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
"Duplicate projection label: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only specify a label once when projecting a record's fields\n\
        \by label.  For example, this is valid:                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────┐                                 \n\
        \    │ { x = 1.1, y = 2.4, z = -0.3 }.{ x, y } │                                 \n\
        \    └─────────────────────────────────────────┘                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but this is not valid:                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────┐                                 \n\
        \    │ { x = 1.1, y = 2.4, z = -0.3 }.{ y, y } │                                 \n\
        \    └─────────────────────────────────────────┘                                 \n\
        \                                          ⇧                                     \n\
        \                                          Invalid: the label ❰y❱ appears twice  \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to project the following field twice:                                 \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k

prettyTypeMessage (MissingField Text
k 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
"Missing record field: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can only access fields on records, like this:                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ { foo = True, bar = \"ABC\" }.foo │  This is valid ...                    \n\
        \    └─────────────────────────────────┘                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────┐                               \n\
        \    │ λ(r : { foo : Bool, bar : Text }) → r.foo │  ... and so is this           \n\
        \    └───────────────────────────────────────────┘                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you can only access fields if they are present                          \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌─────────────────────────────────┐                                         \n\
        \    │ { foo = True, bar = \"ABC\" }.qux │                                       \n\
        \    └─────────────────────────────────┘                                         \n\
        \                                  ⇧                                             \n\
        \                                  Invalid: the record has no ❰qux❱ field        \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to access a field named:                                              \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 field is missing because the record only defines the following      \n\
        \fields:                                                                         \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage (MissingConstructor Text
k 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
"Missing constructor: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can access constructors from unions, like this:                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────┐                                                       \n\
        \    │ < Foo | Bar >.Foo │  This is valid ...                                    \n\
        \    └───────────────────┘                                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you can only access constructors if they match an union alternative of  \n\
        \the same name.                                                                  \n\
        \                                                                                \n\
        \For example, 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\
        \    ┌───────────────────┐                                                       \n\
        \    │ < Foo | Bar >.Baz │                                                       \n\
        \    └───────────────────┘                                                       \n\
        \                    ⇧                                                           \n\
        \                    Invalid: the union has no ❰Baz❱ alternative                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to access a constructor named:                                        \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 constructor is missing because the union only defines the following \n\
        \alternatives:                                                                   \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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0

prettyTypeMessage (ProjectionTypeMismatch Text
k 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
"Projection type mismatch\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
expr2 Expr s a
expr3)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can project a subset of fields from a record by specifying the \n\
        \desired type of the final record, like this:                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────────┐                             \n\
        \    │ { foo = 1, bar = True }.({ foo : Natural }) │  This is valid              \n\
        \    └─────────────────────────────────────────────┘                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the expected type for each desired field must match the actual type of  \n\
        \the corresponding field in the original record.                                 \n\
        \                                                                                \n\
        \For example, 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\
        \              Invalid: The ❰foo❱ field contains ❰1❱, which has type ❰Natural❱...\n\
        \              ⇩                                                                 \n\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │ { foo = 1, bar = True }.({ foo : Text }) │                                \n\
        \    └──────────────────────────────────────────┘                                \n\
        \                                       ⇧                                        \n\
        \                                       ... but we requested that the ❰foo❱ field\n\
        \                                       must contain a value of type ❰Text❱      \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to project out a field named:                                         \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 should have 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 that field instead had a value of 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"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k
        txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr0
        txt2 :: Doc Ann
txt2 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr1

prettyTypeMessage (AssertionFailed 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
"Assertion failed\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
expr1)

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can assert at type-checking time that two terms are equal if   \n\
        \they have the same normal form, like this:                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ assert : 2 + 2 ≡ 4 │  This is valid                                       \n\
        \    └────────────────────┘                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \... and an assertion still succeeds if the normal forms only differ by renaming \n\
        \bound variables, like this:                                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────────────────┐                    \n\
        \    │ assert : λ(n : Natural) → n + 0 ≡ λ(m : Natural) → m │  This is also valid\n\
        \    └──────────────────────────────────────────────────────┘                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \However, an assertion fails if the normal forms differ in any other way.  For   \n\
        \example, the following assertion 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\
        \    │ assert : 0 ≡ 1 │  Invalid: ❰0❱ does not equal ❰1❱                         \n\
        \    └────────────────┘                                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You might have tried to ❰assert❱ a precondition on a function's input, like   \n\
        \  this:                                                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────────────────────────────┐        \n\
        \    │ λ(n : Natural) → let _ = assert : Natural/isZero n ≡ False in n  │        \n\
        \    └──────────────────────────────────────────────────────────────────┘        \n\
        \                                        ⇧                                       \n\
        \                                        Invalid: This assertion will always fail\n\
        \                                                                                \n\
        \                                                                                \n\
        \  This will not work.  Such an assertion is checking all possible inputs to the \n\
        \  function, before you've even used the function at all.                        \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You tried to assert that 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\
        \... is the same as this other expression:                                       \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 they differ\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 (NotAnEquivalence 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
"Not an equivalence\n"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The type annotation for an ❰assert❱ must evaluate to an equivalence\n\
        \of the form ❰x ≡ y❱, like this:                                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ assert : 2 + 2 ≡ 4 │  This is valid                                       \n\
        \    └────────────────────┘                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but any other type is not a valid annotation.  For example, the following   \n\
        \assertion 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\
        \    │ assert : True │  Invalid: ❰True❱ is not an equivalence                    \n\
        \    └───────────────┘                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You tried to supply an expression of type ❰Bool❱ to the assertion, rather than\n\
        \  two separate expressions to compare, like this:                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────┐                                               \n\
        \    │ assert : Natural/isZero 0 │  Invalid: A boolean expression is not the     \n\
        \    └───────────────────────────┘  same thing as a type-level equivalence       \n\
        \                                                                                \n\
        \                                                                                \n\
        \  You have to explicitly compare two expressions, even if that just means       \n\
        \  comparing the expression to ❰True❱, like this:                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ assert : Natural/isZero 0 ≡ True │  Valid: You can assert that two boolean\n\
        \    └──────────────────────────────────┘  expressions are equivalent            \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided the following type annotation for an ❰assert❱:                     \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 an equivalence\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

prettyTypeMessage (IncomparableExpression 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
"Incomparable expression\n"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can use an ❰assert❱ to compare two terms for equivalence, like \n\
        \this:                                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────┐                                                      \n\
        \    │ assert : 2 + 2 ≡ 4 │  This is valid because ❰2 + 2❱ and ❰4❱ are both terms\n\
        \    └────────────────────┘                                                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot compare expressions, that are not terms, such as types.  For \n\
        \example, the following equivalence 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\
        \    │ assert : Natural ≡ Natural │  Invalid: ❰Natural❱ is a type, not a term    \n\
        \    └────────────────────────────┘                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to compare the following 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\
        \... which is not a term\n"
      where
        txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr

prettyTypeMessage (EquivalenceTypeMismatch Expr s a
l Expr s a
_L Expr s a
r Expr s a
_R) = 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
"The two sides of the equivalence have different types"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can use ❰≡❱ to compare two terms of the same type for          \n\
        \equivalence, like this:                                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────┐                                                               \n\
        \    │ 2 + 2 ≡ 4 │  This is valid because ❰2 + 2❱ and ❰4❱ have the same type     \n\
        \    └───────────┘                                                               \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot compare expressions, that have different types.  For example,\n\
        \the following assertion 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\
        \    │ 1 ≡ True │  Invalid: ❰1❱ has type ❰Natural❱, ❰True❱ has type ❰Bool❱       \n\
        \    └──────────┘                                                                \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to compare the following expressions:                                 \n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
l 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
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
_L Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... and\n\
        \                                                                                \n\
        \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
r 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
<> Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
_R Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"

prettyTypeMessage (NotWithARecord 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
"❰with❱ only works on records"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: You can use ❰with❱ to update a record, like this:                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────┐                                                 \n\
        \    │  { a = 5 } with b = 10  │  This is valid because ❰{ a = 5}❱ is a record   \n\
        \    └────────────────────────┘                                                  \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────────────┐                                \n\
        \    │  λ(r : { a : Natural }) → r with b = 10  │  This is also valid because    \n\
        \    └──────────────────────────────────────────┘  ❰r❱ is a record               \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but you cannot use ❰with❱ to update an expression that is not a record.  For\n\
        \example, 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\
        \    ┌───────────────┐                                                           \n\
        \    │ 1 with b = 10 │  Invalid: ❰1❱ is not a record                             \n\
        \    └───────────────┘                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \You tried to update the following expressions:                                  \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
txt1 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\
        \                                                                                \n\
        \... which is not a record 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 (CantAnd Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator Text
"&&" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage (CantOr Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator Text
"||" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage (CantEQ Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator Text
"==" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage (CantNE Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator Text
"!=" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage (CantInterpolate 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
"You can only interpolate ❰Text❱"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: Text interpolation only works on expressions of type ❰Text❱        \n\
        \                                                                                \n\
        \For example, these are all valid uses of string interpolation:                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────┐                                                        \n\
        \    │ \"ABC${\"DEF\"}GHI\" │                                                        \n\
        \    └──────────────────┘                                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────┐                                              \n\
        \    │ λ(x : Text) → \"ABC${x}GHI\" │                                              \n\
        \    └────────────────────────────┘                                              \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────────────────────────────┐                           \n\
        \    │ λ(age : Natural) → \"Age: ${Natural/show age}\" │                           \n\
        \    └───────────────────────────────────────────────┘                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You might have thought that string interpolation automatically converts the   \n\
        \  interpolated value to a ❰Text❱ representation of that value:                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────────────────┐                                        \n\
        \    │ λ(age : Natural) → \"Age: ${age}\" │                                        \n\
        \    └──────────────────────────────────┘                                        \n\
        \                                  ⇧                                             \n\
        \                                  Invalid: ❰age❱ has type ❰Natural❱             \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You might have forgotten to escape a string interpolation that you wanted     \n\
        \  Dhall to ignore and pass through:                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ \"echo ${HOME}\" │                                                          \n\
        \    └────────────────┘                                                          \n\
        \             ⇧                                                                  \n\
        \             ❰HOME❱ is not in scope and this might have meant to use ❰\\${HOME}❱\n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You interpolated 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\
        \... which does not have type ❰Text❱ but instead 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"
      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 (CantTextAppend 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
"❰++❱ only works on ❰Text❱"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰++❱ operator expects two arguments that have type ❰Text❱      \n\
        \                                                                                \n\
        \For example, this is a valid use of ❰++❱:                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────┐                                                          \n\
        \    │ \"ABC\" ++ \"DEF\" │                                                          \n\
        \    └────────────────┘                                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You might have thought that ❰++❱ was the operator to combine two lists:       \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ [1, 2, 3] ++ [4, 5, 6] │  Not valid                                       \n\
        \    └────────────────────────┘                                                  \n\
        \                                                                                \n\
        \                                                                                \n\
        \  ... but the list concatenation operator is actually ❰#❱:                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ [1, 2, 3] # [4, 5, 6] │  Valid                                            \n\
        \    └───────────────────────┘                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided this argument:                                                     \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 does not have type ❰Text❱ but instead 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"
      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 (CantListAppend 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
"❰#❱ only works on ❰List❱s"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰#❱ operator expects two arguments that are both ❰List❱s       \n\
        \                                                                                \n\
        \For example, this is a valid use of ❰#❱:                                        \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────────┐                                                   \n\
        \    │ [1, 2, 3] # [4, 5, 6] │                                                   \n\
        \    └───────────────────────┘                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided this argument:                                                     \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 ❰List❱ but instead 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"
      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 (CantAdd Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildNaturalOperator Text
"+" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage (CantMultiply Expr s a
expr0 Expr s a
expr1) =
        Text -> Expr s a -> Expr s a -> ErrorMessages
forall a s.
Pretty a =>
Text -> Expr s a -> Expr s a -> ErrorMessages
buildNaturalOperator Text
"*" Expr s a
expr0 Expr s a
expr1

prettyTypeMessage TypeMessage s a
OptionalWithTypeMismatch = 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
"❰with❱ cannot change the type of an ❰Optional❱ value"
    hints :: [a]
hints = []
    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰with❱ keyword cannot change the type of a value stored inside \n\
        \of a ❰Some❱ constructor                                                         \n\
        \                                                                                \n\
        \For example, this is a valid use of ❰with❱:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \           The old value has type ❰Natural❱                                     \n\
        \           ⇩                                                                    \n\
        \    ┌───────────────────┐                                                       \n\
        \    │ Some 1 with ? = 2 │                                                       \n\
        \    └───────────────────┘                                                       \n\
        \                      ⇧                                                         \n\
        \                      ... which matches the type of the new value, which is also\n\
        \                      ❰Natural❱                                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the following example is not valid:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \           The old value has type ❰Natural❱                                     \n\
        \           ⇩                                                                    \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ Some 1 with ? = True │                                                    \n\
        \    └──────────────────────┘                                                    \n\
        \                      ⇧                                                         \n\
        \                      ... but the new value has type ❰Bool❱, which does not     \n\
        \                      match                                                     \n"

prettyTypeMessage TypeMessage s a
NotALabelPath = 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
"Use a label to update a record"
    hints :: [a]
hints = []
    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰with❱ keyword supports updating records by naming the field(s)\n\
        \to update, but you provided a path component of ❰?❱, which only works on        \n\
        \❰Optional❱ values and not records.                                              \n\
        \                                                                                \n\
        \For example, these are valid uses of ❰with❱ to update a record:                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ { x = 1 } with x = 2 │                                                    \n\
        \    └──────────────────────┘                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────────────┐                                          \n\
        \    │ { x = { y = 1 } } with x.y = 2 │                                          \n\
        \    └────────────────────────────────┘                                          \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the following example is not valid:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ { x = 1 } with ? = 2 │                                                    \n\
        \    └──────────────────────┘                                                    \n\
        \                     ⇧                                                          \n\
        \                     This path component is reserved for updating ❰Optional❱    \n\
        \                     values and not records                                     \n\
        \                                                                                \n\
        \Note that you can update a field named ❰?❱ if you escape the path component,    \n\
        \though:                                                                         \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌────────────────────────┐                                                  \n\
        \    │ { ? = 1 } with `?` = 2 │                                                  \n\
        \    └────────────────────────┘                                                  \n"

prettyTypeMessage (NotAQuestionPath Text
k) = 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
"Use ❰?❱ to update an ❰Optional❱ value"
    hints :: [a]
hints = []
    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰with❱ keyword supports updating ❰Optional❱ values using a path\n\
        \component of ❰?❱, but you provided a path component other than ❰?❱.             \n\
        \                                                                                \n\
        \For example, these are valid uses of ❰with❱ to update an ❰Optional❱ value:      \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────────┐                                                       \n\
        \    │ Some 1 with ? = 2 │                                                       \n\
        \    └───────────────────┘                                                       \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────┐                                             \n\
        \    │ { x = Some 1 } with x.? = 2 │                                             \n\
        \    └─────────────────────────────┘                                             \n\
        \                                                                                \n\
        \                                                                                \n\
        \... but the following example is not valid:                                     \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌──────────────────────┐                                                    \n\
        \    │ Some 1 with x = True │                                                    \n\
        \    └──────────────────────┘                                                    \n\
        \                  ⇧                                                             \n\
        \                  This path component should have been ❰?❱                      \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided this path component:                                               \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 perhaps should have been ❰?❱.                                         \n"
      where
        txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Text
k

prettyTypeMessage TypeMessage s a
ShowConstructorNotOnUnion = 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
"ShowConstructorNotOnUnion"
      hints :: [a]
hints = []
      long :: Doc Ann
long = Doc Ann
""

buildBooleanOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator :: Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator Text
operator Expr s a
expr0 Expr s a
expr1 = 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
..}
  where
    short :: Doc ann
short = Doc ann
"❰" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
txt2 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"❱ only works on ❰Bool❱s"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱ operator expects two arguments that have type ❰Bool❱\n\
        \                                                                                \n\
        \For example, this is a valid use of ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────────────┐                                                           \n\
        \    │ True " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" False │                                               \n\
        \    └───────────────┘                                                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \You provided this argument:                                                     \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 does not have type ❰Bool❱ but instead 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"
      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 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
operator

buildNaturalOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages
buildNaturalOperator :: Text -> Expr s a -> Expr s a -> ErrorMessages
buildNaturalOperator Text
operator Expr s a
expr0 Expr s a
expr1 = 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
..}
  where
    short :: Doc ann
short = Doc ann
"❰" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
txt2 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"❱ only works on ❰Natural❱s"

    hints :: [a]
hints = []

    long :: Doc Ann
long =
        Doc Ann
"Explanation: The ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱ operator expects two arguments that have type ❰Natural❱\n\
        \                                                                                \n\
        \For example, this is a valid use of ❰" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"❱:                           \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────┐                                                                   \n\
        \    │ 3 " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" 5 │                                                      \n\
        \    └───────┘                                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \Some common reasons why you might get this error:                               \n\
        \                                                                                \n\
        \● You might have tried to use an ❰Integer❱, which 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
" allowed:    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────────────────────────────────────┐                                 \n\
        \    │ λ(x : Integer) → λ(y : Integer) → x " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" y │  Not valid         \n\
        \    └─────────────────────────────────────────┘                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \  You can only use ❰Natural❱ numbers                                            \n\
        \                                                                                \n\
        \                                                                                \n\
        \● You might have mistakenly used an ❰Integer❱ literal, which 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
" allowed:\n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌─────────┐                                                                 \n\
        \    │ +2 " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" +2 │  Not valid                                         \n\
        \    └─────────┘                                                                 \n\
        \                                                                                \n\
        \                                                                                \n\
        \  You need to remove the leading ❰+❱ to transform them into ❰Natural❱ literals, \n\
        \  like this:                                                                    \n\
        \                                                                                \n\
        \                                                                                \n\
        \    ┌───────┐                                                                   \n\
        \    │ 2 " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
forall ann. Doc ann
txt2 Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" 2 │  Valid                                               \n\
        \    └───────┘                                                                   \n\
        \                                                                                \n\
        \                                                                                \n\
        \────────────────────────────────────────────────────────────────────────────────\n\
        \                                                                                \n\
        \You provided this argument:                                                     \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 does not have type ❰Natural❱ but instead 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"
      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 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
operator

-- | A structured type error that includes context
data TypeError s a = TypeError
    { TypeError s a -> Context (Expr s a)
context     :: Context (Expr s a)
    , TypeError s a -> Expr s a
current     :: Expr s a
    , TypeError s a -> TypeMessage s a
typeMessage :: TypeMessage s a
    }

instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where
    show :: TypeError s a -> String
show = SimpleDocStream Ann -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (SimpleDocStream Ann -> String)
-> (TypeError s a -> SimpleDocStream Ann)
-> TypeError s a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc Ann -> SimpleDocStream Ann)
-> (TypeError s a -> Doc Ann)
-> TypeError s a
-> SimpleDocStream Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeError s a -> Doc Ann
forall a s. (Eq a, Pretty s, Pretty a) => TypeError s a -> Doc Ann
prettyTypeError

instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a)

instance (Eq a, Pretty s, Pretty a) => Pretty (TypeError s a) where
    pretty :: TypeError s a -> Doc ann
pretty = Doc Ann -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Doc Ann -> Doc ann)
-> (TypeError s a -> Doc Ann) -> TypeError s a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeError s a -> Doc Ann
forall a s. (Eq a, Pretty s, Pretty a) => TypeError s a -> Doc Ann
prettyTypeError

prettyTypeError :: (Eq a, Pretty s, Pretty a) => TypeError s a -> Doc Ann
prettyTypeError :: TypeError s a -> Doc Ann
prettyTypeError (TypeError Context (Expr s a)
_ Expr s a
expr TypeMessage s a
msg) =
    (   Doc Ann
"\n"
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  TypeMessage s a -> Doc Ann
forall a s. (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
shortTypeMessage TypeMessage s a
msg 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
forall ann. Doc ann
source
    )
  where
    source :: Doc ann
source = case Expr s a
expr of
        Note s
s Expr s a
_ -> s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty s
s
        Expr s a
_        -> Doc ann
forall a. Monoid a => a
mempty

{-| Wrap a type error in this exception type to censor source code and
    `Dhall.Syntax.Text` literals from the error message
-}
data Censored
    = CensoredDetailed (DetailedTypeError Src X)
    | Censored (TypeError Src X)

instance Show Censored where
    show :: Censored -> String
show = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (SimpleDocStream Any -> String)
-> (Censored -> SimpleDocStream Any) -> Censored -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> SimpleDocStream Any
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc Any -> SimpleDocStream Any)
-> (Censored -> Doc Any) -> Censored -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Censored -> Doc Any
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty

instance Exception Censored

instance Pretty Censored where
    pretty :: Censored -> Doc ann
pretty (CensoredDetailed (DetailedTypeError TypeError Src X
e)) =
        DetailedTypeError Src X -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TypeError Src X -> DetailedTypeError Src X
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError (TypeError Src X -> TypeError Src X
forall a. TypeError Src a -> TypeError Src a
censorTypeError TypeError Src X
e))
    pretty (Censored TypeError Src X
e) = TypeError Src X -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TypeError Src X -> TypeError Src X
forall a. TypeError Src a -> TypeError Src a
censorTypeError TypeError Src X
e)

censorTypeError :: TypeError Src a -> TypeError Src a
censorTypeError :: TypeError Src a -> TypeError Src a
censorTypeError (TypeError Context (Expr Src a)
c Expr Src a
e TypeMessage Src a
m) = Context (Expr Src a)
-> Expr Src a -> TypeMessage Src a -> TypeError Src a
forall s a.
Context (Expr s a) -> Expr s a -> TypeMessage s a -> TypeError s a
TypeError Context (Expr Src a)
c' Expr Src a
e' TypeMessage Src a
m'
  where
    c' :: Context (Expr Src a)
c' = (Expr Src a -> Expr Src a)
-> Context (Expr Src a) -> Context (Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
Dhall.Core.censorExpression Context (Expr Src a)
c

    e' :: Expr Src a
e' = Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
Dhall.Core.censorExpression Expr Src a
e

    m' :: TypeMessage Src a
m' = ASetter
  (TypeMessage Src a) (TypeMessage Src a) (Expr Src a) (Expr Src a)
-> (Expr Src a -> Expr Src a)
-> TypeMessage Src a
-> TypeMessage Src a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (TypeMessage Src a) (TypeMessage Src a) (Expr Src a) (Expr Src a)
forall (f :: * -> *) s a t b.
Applicative f =>
(Expr s a -> f (Expr t b))
-> TypeMessage s a -> f (TypeMessage t b)
messageExpressions Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
Dhall.Core.censorExpression TypeMessage Src a
m

-- | @Traversal@ that traverses every `Expr` in a `TypeMessage`
messageExpressions
    :: Applicative f
    => (Expr s a -> f (Expr t b)) -> TypeMessage s a -> f (TypeMessage t b)
messageExpressions :: (Expr s a -> f (Expr t b))
-> TypeMessage s a -> f (TypeMessage t b)
messageExpressions Expr s a -> f (Expr t b)
f TypeMessage s a
m = case TypeMessage s a
m of
    UnboundVariable Text
a ->
        Text -> TypeMessage t b
forall s a. Text -> TypeMessage s a
UnboundVariable (Text -> TypeMessage t b) -> f Text -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a
    InvalidInputType Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
InvalidInputType (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    InvalidOutputType Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
InvalidOutputType (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    NotAFunction Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
NotAFunction (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    TypeMismatch Expr s a
a Expr s a
b Expr s a
c Expr s a
d ->
        Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
TypeMismatch (Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b)
-> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    AnnotMismatch Expr s a
a Expr s a
b Expr s a
c ->
        Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
AnnotMismatch (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    TypeMessage s a
Untyped ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
Untyped
    TypeMessage s a
MissingListType ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
MissingListType
    MismatchedListElements Int
a Expr s a
b Expr s a
c Expr s a
d ->
        Int -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Int -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
MismatchedListElements (Int -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Int -> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
a f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    InvalidListElement Int
a Expr s a
b Expr s a
c Expr s a
d ->
        Int -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Int -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
InvalidListElement (Int -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Int -> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
a f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    InvalidListType Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
InvalidListType (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    TypeMessage s a
ListLitInvariant ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
ListLitInvariant
    InvalidSome Expr s a
a Expr s a
b Expr s a
c ->
        Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
InvalidSome (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    InvalidPredicate Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
InvalidPredicate (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    IfBranchMismatch Expr s a
a Expr s a
b Expr s a
c Expr s a
d ->
        Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
IfBranchMismatch (Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b)
-> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    InvalidFieldType Text
a Expr s a
b ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidFieldType (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    InvalidAlternativeType Text
a Expr s a
b ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidAlternativeType (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    ListAppendMismatch Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
ListAppendMismatch (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    InvalidDuplicateField Text
a Expr s a
b Expr s a
c ->
        Text -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
InvalidDuplicateField Text
a (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    MustUpdateARecord Expr s a
a Expr s a
b Expr s a
c ->
        Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
MustUpdateARecord (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    MustCombineARecord Char
a Expr s a
b Expr s a
c ->
        Char -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Char -> Expr s a -> Expr s a -> TypeMessage s a
MustCombineARecord (Char -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Char -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> f Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    InvalidRecordCompletion Text
a Expr s a
l ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
InvalidRecordCompletion Text
a (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
l
    CompletionSchemaMustBeARecord Expr s a
l Expr s a
r ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CompletionSchemaMustBeARecord (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
l f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
r
    CombineTypesRequiresRecordType Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CombineTypesRequiresRecordType (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    RecordTypeMismatch Const
a Const
b Expr s a
c Expr s a
d ->
        Const -> Const -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Const -> Const -> Expr s a -> Expr s a -> TypeMessage s a
RecordTypeMismatch (Const -> Const -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Const -> f (Const -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Const -> f Const
forall (f :: * -> *) a. Applicative f => a -> f a
pure Const
a f (Const -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Const -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Const -> f Const
forall (f :: * -> *) a. Applicative f => a -> f a
pure Const
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    DuplicateFieldCannotBeMerged NonEmpty Text
a ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Text -> TypeMessage t b
forall s a. NonEmpty Text -> TypeMessage s a
DuplicateFieldCannotBeMerged NonEmpty Text
a)
    FieldCollision NonEmpty Text
a ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Text -> TypeMessage t b
forall s a. NonEmpty Text -> TypeMessage s a
FieldCollision NonEmpty Text
a)
    FieldTypeCollision NonEmpty Text
a ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Text -> TypeMessage t b
forall s a. NonEmpty Text -> TypeMessage s a
FieldTypeCollision NonEmpty Text
a)
    MustMergeARecord Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMergeARecord (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    MustMergeUnionOrOptional Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMergeUnionOrOptional (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    MustMapARecord Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MustMapARecord (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    InvalidToMapRecordKind Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
InvalidToMapRecordKind (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    HeterogenousRecordToMap Expr s a
a Expr s a
b Expr s a
c ->
        Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
HeterogenousRecordToMap (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    InvalidToMapType Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
InvalidToMapType (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    MapTypeMismatch Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
MapTypeMismatch (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    TypeMessage s a
MissingToMapType ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
MissingToMapType
    UnusedHandler Set Text
a ->
        Set Text -> TypeMessage t b
forall s a. Set Text -> TypeMessage s a
UnusedHandler (Set Text -> TypeMessage t b)
-> f (Set Text) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> f (Set Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Text
a
    MissingHandler Text
e Set Text
a ->
        Text -> Set Text -> TypeMessage t b
forall s a. Text -> Set Text -> TypeMessage s a
MissingHandler (Text -> Set Text -> TypeMessage t b)
-> f Text -> f (Set Text -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
e f (Set Text -> TypeMessage t b)
-> f (Set Text) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Text -> f (Set Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Text
a
    HandlerInputTypeMismatch Text
a Expr s a
b Expr s a
c ->
        Text -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
HandlerInputTypeMismatch (Text -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    DisallowedHandlerType Text
a Expr s a
b Expr s a
c Text
d ->
        Text -> Expr t b -> Expr t b -> Text -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> Text -> TypeMessage s a
DisallowedHandlerType (Text -> Expr t b -> Expr t b -> Text -> TypeMessage t b)
-> f Text -> f (Expr t b -> Expr t b -> Text -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> Text -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Text -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Text -> TypeMessage t b)
-> f (Expr t b) -> f (Text -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Text -> TypeMessage t b) -> f Text -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
d
    HandlerOutputTypeMismatch Text
a Expr s a
b Text
c Expr s a
d ->
        Text -> Expr t b -> Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Text -> Expr s a -> TypeMessage s a
HandlerOutputTypeMismatch (Text -> Expr t b -> Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> Text -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Text -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Text -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    InvalidHandlerOutputType Text
a Expr s a
b Expr s a
c ->
        Text -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
InvalidHandlerOutputType (Text -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    TypeMessage s a
MissingMergeType ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
MissingMergeType
    HandlerNotAFunction Text
a Expr s a
b ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
HandlerNotAFunction (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantAccess Text
a Expr s a
b Expr s a
c ->
        Text -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
CantAccess (Text -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    CantProject Text
a Expr s a
b Expr s a
c ->
        Text -> Expr t b -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> Expr s a -> TypeMessage s a
CantProject (Text -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
    CantProjectByExpression Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
CantProjectByExpression (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    DuplicateProjectionLabel Text
a ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TypeMessage t b
forall s a. Text -> TypeMessage s a
DuplicateProjectionLabel Text
a)
    MissingField Text
a Expr s a
b ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
MissingField (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    MissingConstructor Text
a Expr s a
b ->
        Text -> Expr t b -> TypeMessage t b
forall s a. Text -> Expr s a -> TypeMessage s a
MissingConstructor (Text -> Expr t b -> TypeMessage t b)
-> f Text -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    ProjectionTypeMismatch Text
a Expr s a
b Expr s a
c Expr s a
d Expr s a
e ->
        Text
-> Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Text
-> Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
ProjectionTypeMismatch (Text
 -> Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Text
-> f (Expr t b
      -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a f (Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b)
-> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
e
    AssertionFailed Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
AssertionFailed (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    NotAnEquivalence Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
NotAnEquivalence (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    IncomparableExpression Expr s a
a ->
        Expr t b -> TypeMessage t b
forall s a. Expr s a -> TypeMessage s a
IncomparableExpression (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
    EquivalenceTypeMismatch Expr s a
a Expr s a
b Expr s a
c Expr s a
d ->
        Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Expr s a -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
EquivalenceTypeMismatch (Expr t b -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b)
-> f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
d
    NotWithARecord Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
NotWithARecord (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantAnd Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAnd (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantOr Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantOr (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantEQ Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantEQ (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantNE Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantNE (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantInterpolate Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantInterpolate (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantTextAppend Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantTextAppend (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantListAppend Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantListAppend (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantAdd Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantAdd (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    CantMultiply Expr s a
a Expr s a
b ->
        Expr t b -> Expr t b -> TypeMessage t b
forall s a. Expr s a -> Expr s a -> TypeMessage s a
CantMultiply (Expr t b -> Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (Expr t b -> TypeMessage t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> TypeMessage t b)
-> f (Expr t b) -> f (TypeMessage t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
    TypeMessage s a
OptionalWithTypeMismatch ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
OptionalWithTypeMismatch
    TypeMessage s a
NotALabelPath ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
NotALabelPath
    NotAQuestionPath Text
k ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TypeMessage t b
forall s a. Text -> TypeMessage s a
NotAQuestionPath Text
k)
    TypeMessage s a
ShowConstructorNotOnUnion ->
        TypeMessage t b -> f (TypeMessage t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeMessage t b
forall s a. TypeMessage s a
ShowConstructorNotOnUnion

{-| Newtype used to wrap error messages so that they render with a more
    detailed explanation of what went wrong
-}
newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
    deriving (Typeable)

instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where
    show :: DetailedTypeError s a -> String
show = SimpleDocStream Ann -> String
forall ann. SimpleDocStream ann -> String
Pretty.renderString (SimpleDocStream Ann -> String)
-> (DetailedTypeError s a -> SimpleDocStream Ann)
-> DetailedTypeError s a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc Ann -> SimpleDocStream Ann)
-> (DetailedTypeError s a -> Doc Ann)
-> DetailedTypeError s a
-> SimpleDocStream Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DetailedTypeError s a -> Doc Ann
forall a s.
(Eq a, Pretty s, Pretty a) =>
DetailedTypeError s a -> Doc Ann
prettyDetailedTypeError

instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a)

instance (Eq a, Pretty s, Pretty a) => Pretty (DetailedTypeError s a) where
    pretty :: DetailedTypeError s a -> Doc ann
pretty = Doc Ann -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Doc Ann -> Doc ann)
-> (DetailedTypeError s a -> Doc Ann)
-> DetailedTypeError s a
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DetailedTypeError s a -> Doc Ann
forall a s.
(Eq a, Pretty s, Pretty a) =>
DetailedTypeError s a -> Doc Ann
prettyDetailedTypeError

prettyDetailedTypeError :: (Eq a, Pretty s, Pretty a) => DetailedTypeError s a -> Doc Ann
prettyDetailedTypeError :: DetailedTypeError s a -> Doc Ann
prettyDetailedTypeError (DetailedTypeError (TypeError Context (Expr s a)
ctx Expr s a
expr TypeMessage s a
msg)) =
    (   Doc Ann
"\n"
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  (   if [(Text, Expr s a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Context (Expr s a) -> [(Text, Expr s a)]
forall a. Context a -> [(Text, a)]
Dhall.Context.toList Context (Expr s a)
ctx)
            then Doc Ann
""
            else Context (Expr s a) -> Doc Ann
forall s ann. Context (Expr s a) -> Doc ann
prettyContext Context (Expr s a)
ctx Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n\n"
        )
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  TypeMessage s a -> Doc Ann
forall a s. (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
longTypeMessage TypeMessage s a
msg 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
"\n"
    Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<>  Doc Ann
forall ann. Doc ann
source
    )
  where
    prettyKV :: (Text, Expr s a) -> Doc a
prettyKV (Text
key, Expr s a
val) =
        Doc Ann -> Doc a
forall a. Doc Ann -> Doc a
Dhall.Util.snipDoc
            (Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
key Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
" : " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr s a -> Doc Ann
forall a s. Pretty a => Expr s a -> Doc Ann
Dhall.Pretty.prettyExpr Expr s a
val)

    prettyContext :: Context (Expr s a) -> Doc ann
prettyContext =
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
Pretty.vsep
        ([Doc ann] -> Doc ann)
-> (Context (Expr s a) -> [Doc ann])
-> Context (Expr s a)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   ((Text, Expr s a) -> Doc ann) -> [(Text, Expr s a)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Expr s a) -> Doc ann
forall a s a. Pretty a => (Text, Expr s a) -> Doc a
prettyKV
        ([(Text, Expr s a)] -> [Doc ann])
-> (Context (Expr s a) -> [(Text, Expr s a)])
-> Context (Expr s a)
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. [a] -> [a]
reverse
        ([(Text, Expr s a)] -> [(Text, Expr s a)])
-> (Context (Expr s a) -> [(Text, Expr s a)])
-> Context (Expr s a)
-> [(Text, Expr s a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Context (Expr s a) -> [(Text, Expr s a)]
forall a. Context a -> [(Text, a)]
Dhall.Context.toList

    source :: Doc ann
source = case Expr s a
expr of
        Note s
s Expr s a
_ -> s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty s
s
        Expr s a
_        -> Doc ann
forall a. Monoid a => a
mempty

{-| This function verifies that a custom context is well-formed so that
    type-checking will not loop

    Note that `typeWith` already calls `checkContext` for you on the `Context`
    that you supply
-}
checkContext :: Context (Expr s X) -> Either (TypeError s X) ()
checkContext :: Context (Expr s X) -> Either (TypeError s X) ()
checkContext Context (Expr s X)
context =
    case Context (Expr s X) -> Maybe (Text, Expr s X, Context (Expr s X))
forall a. Context a -> Maybe (Text, a, Context a)
Dhall.Context.match Context (Expr s X)
context of
        Maybe (Text, Expr s X, Context (Expr s X))
Nothing ->
            () -> Either (TypeError s X) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Text
x, Expr s X
v, Context (Expr s X)
context') -> do
            let shiftedV :: Expr s X
shiftedV       =       Int -> Var -> Expr s X -> Expr s X
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift (-Int
1) (Text -> Int -> Var
V Text
x Int
0)  Expr s X
v
            let shiftedContext :: Context (Expr s X)
shiftedContext = (Expr s X -> Expr s X) -> Context (Expr s X) -> Context (Expr s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Var -> Expr s X -> Expr s X
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift (-Int
1) (Text -> Int -> Var
V Text
x Int
0)) Context (Expr s X)
context'
            Expr s X
_ <- 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)
shiftedContext Expr s X
shiftedV
            () -> Either (TypeError s X) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

toPath :: (Functor list, Foldable list) => list Text -> Text
toPath :: list Text -> Text
toPath list Text
ks =
    Text -> [Text] -> Text
Text.intercalate Text
"."
        (list Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList ((Text -> Text) -> list Text -> list Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Text -> Text
Dhall.Pretty.Internal.escapeLabel Bool
True) list Text
ks))

duplicateElement :: Ord a => [a] -> Maybe a
duplicateElement :: [a] -> Maybe a
duplicateElement = Set a -> [a] -> Maybe a
forall a. Ord a => Set a -> [a] -> Maybe a
go Set a
forall a. Set a
Data.Set.empty
  where
    go :: Set a -> [a] -> Maybe a
go Set a
_ [] = Maybe a
forall a. Maybe a
Nothing
    go Set a
found (a
x : [a]
xs)
        | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Data.Set.member a
x Set a
found = a -> Maybe a
forall a. a -> Maybe a
Just a
x
        | Bool
otherwise               = Set a -> [a] -> Maybe a
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Data.Set.insert a
x Set a
found) [a]
xs