{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module Dhall.TypeCheck (
typeWith
, typeOf
, typeWithA
, checkContext
, messageExpressions
, 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.Monoid (Endo(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Semigroup (Max(..), Semigroup(..))
import Data.Sequence (Seq, ViewL(..))
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty(..))
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 Dhall.Syntax
( Binding(..)
, Const(..)
, Chunks(..)
, Expr(..)
, PreferAnnotation(..)
, Var(..)
)
import qualified Data.Foldable as Foldable
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.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
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.Set
import qualified Dhall.Syntax as Syntax
import qualified Dhall.Util
import qualified Lens.Family
type X = Void
{-# DEPRECATED X "Use Data.Void.Void instead" #-}
traverseWithIndex_ :: Applicative f => (Int -> a -> f b) -> Seq a -> f ()
traverseWithIndex_ :: (Int -> a -> f b) -> Seq a -> f ()
traverseWithIndex_ k :: Int -> a -> f b
k xs :: Seq a
xs = Seq (f b) -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
Foldable.sequenceA_ ((Int -> a -> f b) -> Seq a -> Seq (f b)
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Data.Sequence.mapWithIndex Int -> a -> f b
k Seq a
xs)
axiom :: Const -> Either (TypeError s a) Const
axiom :: Const -> Either (TypeError s a) Const
axiom Type = Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
Kind
axiom Kind = Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
Sort
axiom 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 Type Type = Const
Type
rule Kind Type = Const
Type
rule Sort Type = Const
Type
rule Type Kind = Const
Kind
rule Kind Kind = Const
Kind
rule Sort Kind = Const
Sort
rule Type Sort = Const
Sort
rule Kind Sort = Const
Sort
rule Sort Sort = Const
Sort
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 ctx :: Context (Expr s X)
ctx expr :: 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
type Typer a = forall s. a -> Expr s a
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 tpa :: Typer a
tpa context :: Context (Expr s a)
context expression :: 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 :: 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 ((x :: Text
x, t :: Expr s a
t):rest :: [(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 vs :: Environment a
vs ts :: 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 {..}) = 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 ts :: Types a
ts x :: Text
x t :: 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 TypesEmpty = Context (Expr s a)
forall a. Context a
Dhall.Context.empty
typesToNames :: Types a -> Names
typesToNames :: Types a -> Names
typesToNames (TypesBind ts :: Types a
ts x :: Text
x _) = 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 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 x :: Text
x t :: Val a
t (Ctx vs :: Environment a
vs ts :: 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 x :: Text
x t :: Val a
t v :: Val a
v (Ctx vs :: Environment a
vs ts :: 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{..} x :: 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))
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 :: Typer a
typer = Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop
where
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{..} expression :: Expr s a
expression = case Expr s a
expression of
Const c :: Const
c -> do
(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 x0 :: Text
x0 n0 :: Int
n0) -> do
let go :: Types a -> t -> Either (TypeError s a) (Val a)
go TypesEmpty _ =
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 ts :: Types a
ts x :: Text
x t :: Val a
t) n :: 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
== 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
- 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 x :: Text
x _A :: Expr s a
_A b :: 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 _ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 _ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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' (\u :: 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 x :: Text
x _A :: Expr s a
_A _B :: 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 kA :: Const
kA -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
kA
_ -> 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 kB :: Const
kB -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
kB
_ -> 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 f :: Expr s a
f a :: 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 (_x :: Text
_x, _A₀' :: Val a
_A₀', _B' :: 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₁'')
Nothing -> do
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, ..}) body :: 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
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 (_, _A₀ :: 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 do
() -> 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 t :: Expr s a
t _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 _ -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 do
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₁'')
Bool -> do
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 _ -> do
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 l :: Expr s a
l r :: 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 l :: Expr s a
l r :: 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 l :: Expr s a
l r :: 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 l :: Expr s a
l r :: 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 t :: Expr s a
t l :: Expr s a
l r :: 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
VBool -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
tL' <- 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'
case Val a
tL' of
VConst Type -> do
() -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> do
let tL'' :: Expr s a
tL'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tL'
TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Bool -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Bool -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
IfBranchMustBeTerm Bool
True Expr s a
l Expr s a
forall s. Expr s a
_L'' Expr s a
forall s. Expr s a
tL'')
Val a
tR' <- 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'
case Val a
tR' of
VConst Type -> do
() -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> do
let tR'' :: Expr s a
tR'' = Names -> Val a -> Expr s a
forall a s. Eq a => Names -> Val a -> Expr s a
quote Names
names Val a
tR'
TypeMessage s a -> Either (TypeError s a) ()
forall b. TypeMessage s a -> Either (TypeError s a) b
die (Bool -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
forall s a.
Bool -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
IfBranchMustBeTerm Bool
True Expr s a
r Expr s a
forall s. Expr s a
_R'' Expr s a
forall s. Expr s a
tR'')
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'
Natural -> do
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 _ -> do
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VNatural
NaturalFold -> do
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 "natural" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\natural :: Val a
natural ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "succ" (Val a
natural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
natural) (\_succ :: Val a
_succ ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "zero" Val a
natural (\_zero :: Val a
_zero ->
Val a
natural
)
)
)
)
NaturalBuild -> do
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 "natural" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\natural :: Val a
natural ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "succ" (Val a
natural Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
natural) (\_succ :: Val a
_succ ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "zero" Val a
natural (\_zero :: 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
)
NaturalIsZero -> do
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)
NaturalEven -> do
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)
NaturalOdd -> do
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)
NaturalToInteger -> do
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)
NaturalShow -> do
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)
NaturalSubtract -> do
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 l :: Expr s a
l r :: 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
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 l :: Expr s a
l r :: 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
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VNatural -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
Integer -> do
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 _ -> do
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VInteger
IntegerClamp -> do
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)
IntegerNegate -> do
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)
IntegerShow -> do
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)
IntegerToDouble -> do
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)
Double -> do
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 _ -> do
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
VDouble
DoubleShow -> do
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)
Text -> do
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 xys :: [(Text, Expr s a)]
xys _) -> do
let process :: (a, Expr s a) -> Either (TypeError s a) ()
process (_, y :: 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
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 l :: Expr s a
l r :: 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
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
VText -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
TextShow -> do
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)
List -> do
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 Nothing ts₀ :: Seq (Expr s a)
ts₀ -> do
case Seq (Expr s a) -> ViewL (Expr s a)
forall a. Seq a -> ViewL a
Data.Sequence.viewl Seq (Expr s a)
ts₀ of
t₀ :: Expr s a
t₀ :< ts₁ :: 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 Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 i :: Int
i t₁ :: 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 do
() -> 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₁'
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
+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 (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f ()
traverseWithIndex_ 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₀')
_ -> 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
MissingListType
ListLit (Just _T₀ :: Expr s a
_T₀) ts :: Seq (Expr s a)
ts -> do
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 -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return 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
InvalidListType Expr s a
forall s. Expr s a
_T₀'')
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 x :: Expr s a
x y :: 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 _A₀' :: Val a
_A₀' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> 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 _A₁' :: Val a
_A₁' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> 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₀')
ListBuild -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: Val a
a ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "list" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\list :: Val a
list ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "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) (\_cons :: Val a
_cons ->
(Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "nil" Val a
list (\_nil :: 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
)
)
ListFold -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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 "list" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\list :: Val a
list ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "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) (\_cons :: Val a
_cons ->
(Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "nil" Val a
list (\_nil :: Val a
_nil -> Val a
list))
)
)
)
)
ListLength -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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))
ListHead -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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))
ListLast -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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))
ListIndexed -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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
[ ("index", Val a
forall a. Val a
VNatural)
, ("value", Val a
a )
]
)
)
)
)
ListReverse -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: 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))
Optional -> do
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)
None -> do
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 "A" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\_A :: Val a
_A -> Val a -> Val a
forall a. Val a -> Val a
VOptional Val a
_A))
Some a :: 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 Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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')
OptionalFold -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: Val a
a ->
Val a -> Val a
forall a. Val a -> Val a
VOptional 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 "optional" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\optional :: Val a
optional ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "just" (Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
optional) (\_just :: Val a
_just ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "nothing" Val a
optional (\_nothing :: Val a
_nothing ->
Val a
optional
)
)
)
)
)
OptionalBuild -> do
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 "a" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\a :: Val a
a ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "optional" (Const -> Val a
forall a. Const -> Val a
VConst Const
Type) (\optional :: Val a
optional ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "just" (Val a
a Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
~> Val a
optional) (\_just :: Val a
_just ->
Text -> Val a -> (Val a -> Val a) -> Val a
forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi "nothing" Val a
optional (\_nothing :: Val a
_nothing ->
Val a
optional
)
)
)
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
)
)
Record xTs :: Map Text (Expr s a)
xTs -> do
let process :: Text -> Expr s a -> WriterT (Max Const) (Either (TypeError s a)) ()
process x :: Text
x _T :: 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 c :: 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)
_ -> 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 c :: 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
-> Expr s a -> WriterT (Max Const) (Either (TypeError s a)) ())
-> Map Text (Expr 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 -> Expr s a -> WriterT (Max Const) (Either (TypeError s a)) ()
process Map Text (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)
RecordLit xts :: Map Text (Expr s a)
xts -> do
let process :: Expr s a -> Either (TypeError s a) (Val a)
process t :: 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
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 <- (Expr s a -> Either (TypeError s a) (Val a))
-> Map Text (Expr 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 Expr s a -> Either (TypeError s a) (Val a)
process (Map Text (Expr s a) -> Map Text (Expr s a)
forall k v. Map k v -> Map k v
Dhall.Map.sort Map Text (Expr 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 xTs :: Map Text (Maybe (Expr s a))
xTs -> do
let process :: Text -> Maybe (Expr s a) -> Either (TypeError s a) (Max Const)
process _ Nothing = do
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 x₁ :: Text
x₁ (Just _T₁ :: 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 c :: 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)
_ -> 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 c :: 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 mk :: Maybe Text
mk l :: Expr s a
l r :: 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
l)
Map Text (Val a)
xLs' <- case Val a
_L' of
VRecord xLs' :: Map Text (Val a)
xLs' -> do
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'
_ -> 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
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 '∧' Expr s a
forall s. Expr s a
l'' Expr s a
forall s. Expr s a
_L'')
Just t :: 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 xRs' :: Map Text (Val a)
xRs' -> do
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'
_ -> 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
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 '∧' Expr s a
forall s. Expr s a
r'' Expr s a
forall s. Expr s a
_R'')
Just t :: 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 xs :: [Text]
xs xLs₀' :: Map Text (Val a)
xLs₀' xRs₀' :: Map Text (Val a)
xRs₀' = do
let combine :: Text -> Val a -> Val a -> Either (TypeError s a) (Val a)
combine x :: Text
x (VRecord xLs₁' :: Map Text (Val a)
xLs₁') (VRecord xRs₁' :: 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 x :: Text
x _ _ = do
case Maybe Text
mk of
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 t :: 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 (\_x :: Text
_x _E :: 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 l :: Expr s a
l r :: 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 cL :: Const
cL -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
cL
_ -> 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 cR :: Const
cR -> Const -> Either (TypeError s a) Const
forall (m :: * -> *) a. Monad m => a -> m a
return Const
cR
_ -> 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 xLs' :: 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'
_ -> 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 xRs' :: 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'
_ -> 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 xs :: [Text]
xs xLs₀' :: Map Text (Val a)
xLs₀' xRs₀' :: Map Text (Val a)
xRs₀' = do
let combine :: Text -> Val a -> Val a -> Either (TypeError s a) ()
combine x :: Text
x (VRecord xLs₁' :: Map Text (Val a)
xLs₁') (VRecord xRs₁' :: 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 x :: Text
x _ _ =
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 a :: PreferAnnotation s a
a l :: Expr s a
l r :: 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 xLs' :: 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'
_ -> 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 withExpression :: 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'')
_ ->
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 '⫽' 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 xRs' :: 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'
_ -> 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 '⫽' 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 l :: Expr s a
l r :: 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 xLs' :: 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 "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 "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 "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 "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 (PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
forall s a.
PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer PreferAnnotation s a
forall s a. PreferAnnotation s a
PreferFromCompletion (Expr s a -> Text -> Expr s a
forall s a. Expr s a -> Text -> Expr s a
Field Expr s a
l "default") Expr s a
r) (Expr s a -> Text -> Expr s a
forall s a. Expr s a -> Text -> Expr s a
Field Expr s a
l "Type"))
_ -> 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'))
Merge t :: Expr s a
t u :: Expr s a
u mT₁ :: 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 yTs' :: Map Text (Val a)
yTs' -> do
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'
_ -> 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 yUs' :: Map Text (Maybe (Val a))
yUs' -> do
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 _O' :: Val a
_O' ->
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 [("None", Maybe (Val a)
forall a. Maybe a
Nothing), ("Some", Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just Val a
_O')])
_ -> 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 (exemplar :: Text
exemplar,rest :: 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 _y :: Text
_y _T₀' :: Val a
_T₀' Nothing =
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'
match y :: Text
y handler' :: Val a
handler' (Just _A₁' :: 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 (x :: Text
x, _A₀' :: Val a
_A₀', _T₀' :: Val a -> Val a
_T₀') -> do
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₁'
let containsBadVar :: Expr s a -> Bool
containsBadVar (Var (V _ n :: Int
n)) =
Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0
containsBadVar e :: 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 1 (Text -> Int -> Var
V Text
x (-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₀'')
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 Nothing (y₁ :: Text
y₁, _T₁' :: 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 (y₀ :: Text
y₀, _T₀' :: Val a
_T₀')) (y₁ :: Text
y₁, _T₁' :: 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
$ \_T₁ :: 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
(Nothing, 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
(Nothing, Just _T₁' :: Val a
_T₁') ->
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₁'
(Just _T₀' :: Val a
_T₀', Nothing) ->
Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T₀'
(Just _T₀' :: Val a
_T₀', Just _T₁' :: Val a
_T₁') -> do
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 e :: Expr s a
e mT₁ :: 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 xTs' :: 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'
_ -> 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 Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 _T₀' :: Val a
_T₀' 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 _T₀' :: Val a
_T₀' r :: Maybe (Either (TypeError s a) (Val a))
r@(Just (Right _T₁' :: 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 _T₀' :: Val a
_T₀' r :: Maybe (Either (TypeError s a) (Val a))
r@(Just (Left _)) =
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 _T' :: 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
[("mapKey", Val a
forall a. Val a
VText), ("mapValue", Val a
_T')]
)
)
case (Maybe (Either (TypeError s a) (Val a))
r, Maybe (Val a)
mT₁') of
(Nothing, Nothing) -> 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
MissingToMapType
(Just err :: Either (TypeError s a) (Val a)
err@(Left _), _) -> do
Either (TypeError s a) (Val a)
err
(Just (Right _T' :: Val a
_T'), Nothing) -> do
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')
(Nothing, Just _T₁' :: Val a
_T₁'@(VList (VRecord itemTypes :: Map Text (Val a)
itemTypes)))
| Just _T' :: 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 "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₁' -> do
Val a -> Either (TypeError s a) (Val a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val a
_T₁'
(Nothing, Just _T₁' :: 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 _T' :: Val a
_T'), Just _T₁' :: 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₁' -> do
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₁'')
Field e :: Expr s a
e x :: 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 xTs' :: Map Text (Val a)
xTs' -> do
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 _T' :: Val a
_T' -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
_T'
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'')
_ -> 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 xTs' :: Map Text (Maybe (Val a))
xTs' -> do
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 _T' :: 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
e'))
Just Nothing -> Val a -> Either (TypeError s a) (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
e'
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)
_ -> 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 e :: Expr s a
e (Left xs :: Set Text
xs) -> 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 xTs' :: Map Text (Val a)
xTs' -> do
let process :: Text -> Either (TypeError s a) (Text, Val a)
process x :: 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 _T' :: 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')
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 (Set Text -> [Text]
forall a. Set a -> [a]
Dhall.Set.toAscList Set Text
xs))
_ -> do
let text :: Text
text =
Doc Ann -> Text
forall ann. Doc ann -> Text
Dhall.Pretty.Internal.docToStrictText (Set Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabels Set 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 e :: Expr s a
e (Right s :: 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 xEs' :: 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 xSs' :: 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 x :: Text
x _S' :: 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
Nothing -> do
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 _E' :: Val a
_E' -> do
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'
_ -> do
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)
_ -> 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 _T :: 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 x' :: Val a
x' y' :: 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'')
_ -> do
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 x :: Expr s a
x y :: 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 Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 Type -> () -> Either (TypeError s a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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)
e :: Expr s a
e@With{} -> do
Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Syntax.desugarWith Expr s a
e)
Note s :: s
s e :: 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 ctx' :: Context (Expr s a)
ctx' (Note s' :: s
s' e' :: Expr s a
e') m :: 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 ctx' :: Context (Expr s a)
ctx' e' :: Expr s a
e' m :: 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 r :: Val a
r ->
Val a -> Either (TypeError s a) (Val a)
forall a b. b -> Either a b
Right Val a
r
ImportAlt l :: Expr s a
l _r :: Expr s a
_r -> do
Ctx a -> Expr s a -> Either (TypeError s a) (Val a)
loop Ctx a
ctx Expr s a
l
Embed p :: a
p -> do
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 err :: 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 vs :: Environment a
vs e :: 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 ns :: Names
ns value :: 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 :: 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
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)
| IfBranchMustBeTerm Bool (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)
| 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)
| 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)
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)
shortTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> Doc Ann
shortTypeMessage :: TypeMessage s a -> Doc Ann
shortTypeMessage msg :: TypeMessage s a
msg =
"\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
<> "\n"
where
ErrorMessages {..} = 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 msg :: TypeMessage s a
msg =
"\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
<> "\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
long
where
ErrorMessages {..} = TypeMessage s a -> ErrorMessages
forall a s. (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
prettyTypeMessage TypeMessage s a
msg
data ErrorMessages = ErrorMessages
{ ErrorMessages -> Doc Ann
short :: Doc Ann
, ErrorMessages -> Doc Ann
long :: Doc Ann
}
_NOT :: Doc ann
_NOT :: Doc ann
_NOT = "\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
prettyTypeMessage :: (Eq a, Pretty a) => TypeMessage s a -> ErrorMessages
prettyTypeMessage :: TypeMessage s a -> ErrorMessages
prettyTypeMessage (UnboundVariable x :: Text
x) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "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
long :: Doc Ann
long =
"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 :: Expr s a
expr) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid function input"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 :: Expr s a
expr) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid function output"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Not a function"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2 expr3 :: Expr s a
expr3) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Wrong type of function argument\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Expression doesn't match annotation\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 Untyped = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰Sort❱ has no type, kind, or sort"
long :: Doc Ann
long =
"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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid predicate for ❰if❱: "
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 (IfBranchMustBeTerm b :: Bool
b expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰if❱ branch is not a term"
long :: Doc Ann
long =
"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 expressions must be a “term”, where a “term” is defined as an expression \n\
\that has a type thas has kind ❰Type❱ \n\
\ \n\
\For example, the following expressions are all valid “terms”: \n\
\ \n\
\ \n\
\ ┌────────────────────┐ \n\
\ │ 1 : Natural : Type │ ❰1❱ is a term with a type (❰Natural❱) of kind ❰Type❱\n\
\ └────────────────────┘ \n\
\ ⇧ \n\
\ term \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────────┐ \n\
\ │ Natural/odd : Natural → Bool : Type │ ❰Natural/odd❱ is a term with a type\n\
\ └─────────────────────────────────────┘ (❰Natural → Bool❱) of kind ❰Type❱ \n\
\ ⇧ \n\
\ term \n\
\ \n\
\ \n\
\However, 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
<> " valid terms: \n\
\ \n\
\ \n\
\ ┌────────────────────┐ \n\
\ │ Text : Type : Kind │ ❰Text❱ has kind (❰Type❱) of sort ❰Kind❱ and is \n\
\ └────────────────────┘ therefore not a term \n\
\ ⇧ \n\
\ type \n\
\ \n\
\ \n\
\ ┌───────────────────────────┐ \n\
\ │ List : Type → Type : Kind │ ❰List❱ has kind (❰Type → Type❱) of sort \n\
\ └───────────────────────────┘ ❰Kind❱ and is therefore not a term \n\
\ ⇧ \n\
\ type-level function \n\
\ \n\
\ \n\
\This means that you cannot define an ❰if❱ expression that returns a type. For \n\
\example, the following ❰if❱ 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
<> " valid: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────┐ \n\
\ │ if True then Text else Bool │ Invalid ❰if❱ expression \n\
\ └─────────────────────────────┘ \n\
\ ⇧ ⇧ \n\
\ type type \n\
\ \n\
\ \n\
\Your ❰" 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
<> "❱ branch of your ❰if❱ expression 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
<> "\n\
\ \n\
\... which has kind: \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
<> "\n\
\ \n\
\... of sort: \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
<> "\n\
\ \n\
\... and is not a term. Therefore your ❰if❱ expression is not valid \n"
where
txt0 :: Doc Ann
txt0 = if Bool
b then "then" else "else"
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
txt3 :: Doc Ann
txt3 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert Expr s a
expr2
prettyTypeMessage (IfBranchMismatch expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2 expr3 :: Expr s a
expr3) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰if❱ branches must have matching types\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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
<> "\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 -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Internal error: A non-empty list literal violated an internal invariant"
long :: Doc Ann
long =
"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 expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid type for ❰List❱"
long :: Doc Ann
long =
"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
<> " 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
<> " 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
<> "\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 MissingListType = do
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "An empty list requires a type annotation"
long :: Doc Ann
long =
"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 i :: Int
i expr0 :: Expr s a
expr0 _expr1 :: Expr s a
_expr1 expr2 :: Expr s a
expr2) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "List elements should all have the same type\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> " 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
<> "\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 i :: Int
i expr0 :: Expr s a
expr0 _expr1 :: Expr s a
_expr1 expr2 :: Expr s a
expr2) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "List element has the wrong type\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> " 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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰Some❱ argument has the wrong type"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 k :: Text
k expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid field type"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 k :: Text
k expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Invalid alternative type"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "You can only append ❰List❱s with matching element types\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "The completion schema must be a record"
long :: Doc Ann
long =
"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
<> "\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
<> "\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 fieldName :: Text
fieldName expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "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
long :: Doc Ann
long =
"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
<> "\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
<> "\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 withExpression :: Expr s a
withExpression expression :: Expr s a
expression typeExpression :: Expr s a
typeExpression) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "You can only update records"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\n"
where
withExpression' :: Expr s a
withExpression' = case Expr s a
withExpression of
With record :: Expr s a
record keys :: NonEmpty Text
keys value :: Expr s a
value -> Expr s a -> NonEmpty Text -> Expr s a -> Expr s a
forall s a. Expr s a -> NonEmpty Text -> 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 Text
keys Expr s a
value
_ -> Expr s a
withExpression
prettyTypeMessage (MustCombineARecord c :: Char
c expression :: Expr s a
expression typeExpression :: Expr s a
typeExpression) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
action :: Doc Ann
action = case Char
c of
'∧' -> "combine"
_ -> "override"
short :: Doc Ann
short = "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
<> " records"
long :: Doc Ann
long =
"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
<> " 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
<> "❱ 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
<> " { 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
<> " { 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
<> " 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
<> " 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
<> " 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
<> " { 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
<> " < 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
<> "\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
<> "\n"
where
op :: Doc ann
op = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c
prettyTypeMessage (InvalidDuplicateField k :: Text
k expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "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
long :: Doc Ann
long =
"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
<> "\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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰⩓❱ requires arguments that are record types"
long :: Doc Ann
long =
"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
<> "\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
<> "\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 const0 :: Const
const0 const1 :: Const
const1 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Record type mismatch"
long :: Doc Ann
long =
"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
<> "\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
<> "\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
<> "\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
<> "\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 ks :: NonEmpty Text
ks) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 ks :: NonEmpty Text
ks) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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 ks :: NonEmpty Text
ks) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰merge❱ expects a record of handlers"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰merge❱ expects a union or an ❰Optional❱"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 ks :: Set Text
ks) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Unused handler"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 ", " (Set Text -> [Text]
forall a. Set a -> [a]
Data.Set.toList Set Text
ks))
prettyTypeMessage (MissingHandler exemplar :: Text
exemplar ks :: Set Text
ks) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = case Set Text -> [Text]
forall a. Set a -> [a]
Data.Set.toList Set Text
ks of
[] -> "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@(_:_) -> "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)
long :: Doc Ann
long =
"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
<> " 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
<> "\n"
where
txt0 :: Doc Ann
txt0 = Text -> Doc Ann
forall a. Pretty a => a -> Doc Ann
insert (Text -> [Text] -> Text
Text.intercalate ", " (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 MissingMergeType =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "An empty ❰merge❱ requires a type annotation"
long :: Doc Ann
long =
"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 expr0 :: Text
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Wrong handler input type\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 label :: Text
label handlerType :: Expr s a
handlerType handlerOutputType :: Expr s a
handlerOutputType variable :: Text
variable) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Disallowed handler type"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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
<> "\n"
prettyTypeMessage (InvalidHandlerOutputType expr0 :: Text
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Wrong handler output type\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 key0 :: Text
key0 expr0 :: Expr s a
expr0 key1 :: Text
key1 expr1 :: Expr s a
expr1) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Handlers should have the same output type\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "❱ 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
<> "\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
<> "❱ 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
<> "\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 k :: Text
k expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "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
<> " is not a function"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 _expr0 :: Expr s a
_expr0 _expr1 :: Expr s a
_expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰toMap❱ expects a record value"
long :: Doc Ann
long =
"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 type_ :: Expr s a
type_ kind :: Expr s a
kind) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰toMap❱ expects a record of kind ❰Type❱"
long :: Doc Ann
long =
"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
<> "\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
<> "\n"
prettyTypeMessage (HeterogenousRecordToMap _expr0 :: Expr s a
_expr0 _expr1 :: Expr s a
_expr1 _expr2 :: Expr s a
_expr2) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰toMap❱ expects a homogenous record"
long :: Doc ann
long =
"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
<> " valid: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────────────┐ \n\
\ │ toMap { Foo = True, Bar = 0 } │ \n\
\ └─────────────────────────────────────────┘ \n\
\ ⇧ ⇧ \n\
\ Bool Natural \n"
prettyTypeMessage (MapTypeMismatch expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰toMap❱ result type doesn't match annotation"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"Explanation: a ❰toMap❱ application has been annotated with a type that doesn't \n\
\match its inferred type. \n"
prettyTypeMessage (InvalidToMapType expr :: Expr s a
expr) =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "An empty ❰toMap❱ was annotated with an invalid type"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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
long :: Doc Ann
long =
"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 MissingToMapType =
ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "An empty ❰toMap❱ requires a type annotation"
long :: Doc Ann
long =
"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 lazyText0 :: Text
lazyText0 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Not a record or a union"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 lazyText0 :: Text
lazyText0 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Not a record"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 :: Expr s a
expr) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Selector is not a record type"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 (MissingField k :: Text
k expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "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
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 k :: Text
k expr0 :: Expr s a
expr0) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Missing constructor: " Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Ann
Dhall.Pretty.Internal.prettyLabel Text
k
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 k :: Text
k expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 expr2 :: Expr s a
expr2 expr3 :: Expr s a
expr3) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Projection type mismatch\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Assertion failed\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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)
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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 :: Expr s a
expr) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Not an equivalence\n"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 :: Expr s a
expr) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "Incomparable expression\n"
long :: Doc Ann
long =
"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
<> " 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
<> "\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 l :: Expr s a
l _L :: Expr s a
_L r :: Expr s a
r _R :: Expr s a
_R) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "The two sides of the equivalence have different types"
long :: Doc Ann
long =
"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
<> " 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
<> "\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
<> "\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
<> "\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
<> "\n"
prettyTypeMessage (CantAnd expr0 :: Expr s a
expr0 expr1 :: 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 "&&" Expr s a
expr0 Expr s a
expr1
prettyTypeMessage (CantOr expr0 :: Expr s a
expr0 expr1 :: 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 "||" Expr s a
expr0 Expr s a
expr1
prettyTypeMessage (CantEQ expr0 :: Expr s a
expr0 expr1 :: 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 "==" Expr s a
expr0 Expr s a
expr1
prettyTypeMessage (CantNE expr0 :: Expr s a
expr0 expr1 :: 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 "!=" Expr s a
expr0 Expr s a
expr1
prettyTypeMessage (CantInterpolate expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "You can only interpolate ❰Text❱"
long :: Doc Ann
long =
"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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰++❱ only works on ❰Text❱"
long :: Doc Ann
long =
"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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1) = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc Ann
short = "❰#❱ only works on ❰List❱s"
long :: Doc Ann
long =
"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
<> "\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
<> "\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 expr0 :: Expr s a
expr0 expr1 :: 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 "+" Expr s a
expr0 Expr s a
expr1
prettyTypeMessage (CantMultiply expr0 :: Expr s a
expr0 expr1 :: 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 "*" Expr s a
expr0 Expr s a
expr1
buildBooleanOperator :: Pretty a => Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator :: Text -> Expr s a -> Expr s a -> ErrorMessages
buildBooleanOperator operator :: Text
operator expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "❰" 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
<> "❱ only works on ❰Bool❱s"
long :: Doc Ann
long =
"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
<> "❱ 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
<> "❱: \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
<> " 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
<> "\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
<> "\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 operator :: Text
operator expr0 :: Expr s a
expr0 expr1 :: Expr s a
expr1 = ErrorMessages :: Doc Ann -> Doc Ann -> ErrorMessages
ErrorMessages {..}
where
short :: Doc ann
short = "❰" 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
<> "❱ only works on ❰Natural❱s"
long :: Doc Ann
long =
"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
<> "❱ 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
<> "❱: \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
<> " 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
<> " 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
<> " 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
<> " 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
<> " +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
<> " 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
<> "\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
<> "\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
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 _ expr :: Expr s a
expr msg :: TypeMessage s a
msg) =
( "\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
<> "\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
s _ -> s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty s
s
_ -> Doc ann
forall a. Monoid a => a
mempty
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 e :: 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 e :: 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 c :: Context (Expr Src a)
c e :: Expr Src a
e m :: 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
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 f :: Expr s a -> f (Expr t b)
f m :: TypeMessage s a
m = case TypeMessage s a
m of
UnboundVariable a :: 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 a :: 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 a :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: Expr s a
b c :: Expr s a
c d :: 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 a :: Expr s a
a b :: Expr s a
b c :: 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
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
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 a :: Int
a b :: Expr s a
b c :: Expr s a
c d :: 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 a :: Int
a b :: Expr s a
b c :: Expr s a
c d :: 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 a :: 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
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 a :: Expr s a
a b :: Expr s a
b c :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: Expr s a
b c :: Expr s a
c d :: 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
IfBranchMustBeTerm a :: Bool
a b :: Expr s a
b c :: Expr s a
c d :: Expr s a
d ->
Bool -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b
forall s a.
Bool -> Expr s a -> Expr s a -> Expr s a -> TypeMessage s a
IfBranchMustBeTerm (Bool -> Expr t b -> Expr t b -> Expr t b -> TypeMessage t b)
-> f Bool
-> 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
<$> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
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 a :: Text
a b :: 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 a :: Text
a b :: 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 a :: Expr s a
a b :: 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 a :: Text
a b :: Expr s a
b c :: 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 a :: Expr s a
a b :: Expr s a
b c :: 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 a :: Char
a b :: Expr s a
b c :: 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 a :: Text
a l :: 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 l :: Expr s a
l r :: 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 a :: Expr s a
a b :: 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 a :: Const
a b :: Const
b c :: Expr s a
c d :: 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 a :: 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 a :: 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 a :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: Expr s a
b c :: 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 a :: 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 a :: Expr s a
a b :: 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
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 a :: 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 e :: Text
e a :: 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 a :: Text
a b :: Expr s a
b c :: 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 a :: Text
a b :: Expr s a
b c :: Expr s a
c d :: 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 a :: Text
a b :: Expr s a
b c :: Text
c d :: 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 a :: Text
a b :: Expr s a
b c :: 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
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 a :: Text
a b :: 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 a :: Text
a b :: Expr s a
b c :: 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 a :: Text
a b :: Expr s a
b c :: 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 a :: 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
MissingField a :: Text
a b :: 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 a :: Text
a b :: 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 a :: Text
a b :: Expr s a
b c :: Expr s a
c d :: Expr s a
d e :: 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 a :: Expr s a
a b :: 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 a :: 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 a :: 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 a :: Expr s a
a b :: Expr s a
b c :: Expr s a
c d :: 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
CantAnd a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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 a :: Expr s a
a b :: 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
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 ctx :: Context (Expr s a)
ctx expr :: Expr s a
expr msg :: TypeMessage s a
msg)) =
( "\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 ""
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
<> "\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
<> "\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "────────────────────────────────────────────────────────────────────────────────\n"
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\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 (key :: Text
key, val :: 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
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
s _ -> s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty s
s
_ -> Doc ann
forall a. Monoid a => a
mempty
checkContext :: Context (Expr s X) -> Either (TypeError s X) ()
checkContext :: Context (Expr s X) -> Either (TypeError s X) ()
checkContext context :: 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
Nothing -> do
() -> Either (TypeError s X) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (x :: Text
x, v :: Expr s X
v, context' :: 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 (-1) (Text -> Int -> Var
V Text
x 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 (-1) (Text -> Int -> Var
V Text
x 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 ks :: list Text
ks =
Text -> [Text] -> Text
Text.intercalate "."
(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))