Safe Haskell | None |
---|---|
Language | Haskell98 |
This module contains the logic for type checking Dhall code
- typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
- typeOf :: Expr s X -> Either (TypeError s X) (Expr s X)
- typeWithA :: Eq a => Typer a -> Context (Expr s a) -> Expr s a -> Either (TypeError s a) (Expr s a)
- checkContext :: Context (Expr s X) -> Either (TypeError s X) ()
- type Typer a = forall s. a -> Expr s a
- newtype X = X {
- absurd :: forall a. a
- data TypeError s a = TypeError {
- context :: Context (Expr s a)
- current :: Expr s a
- typeMessage :: TypeMessage s a
- newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
- 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)
- | InvalidOptionalElement (Expr s a) (Expr s a) (Expr s a)
- | InvalidOptionalType (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)
- | InvalidField Text (Expr s a)
- | InvalidFieldType Text (Expr s a)
- | InvalidAlternative Text (Expr s a)
- | InvalidAlternativeType Text (Expr s a)
- | ListAppendMismatch (Expr s a) (Expr s a)
- | DuplicateAlternative Text
- | MustCombineARecord Char (Expr s a) (Expr s a)
- | FieldCollision Text
- | MustMergeARecord (Expr s a) (Expr s a)
- | MustMergeUnion (Expr s a) (Expr s a)
- | UnusedHandler (Set Text)
- | MissingHandler (Set Text)
- | HandlerInputTypeMismatch Text (Expr s a) (Expr s a)
- | HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a)
- | InvalidHandlerOutputType Text (Expr s a) (Expr s a)
- | MissingMergeType
- | HandlerNotAFunction Text (Expr s a)
- | ConstructorsRequiresAUnionType (Expr s a) (Expr s a)
- | NotARecord Text (Expr s a) (Expr s a)
- | MissingField Text (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)
- | NoDependentTypes (Expr s a) (Expr s a)
Type-checking
typeWith :: Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X) Source #
Type-check an expression and return the expression's type if type-checking succeeds or an error if type-checking fails
typeWith
does not necessarily normalize the type since full normalization
is not necessary for just type-checking. If you actually care about the
returned type then you may want to normalize
it afterwards.
typeWithA :: Eq a => Typer a -> Context (Expr s a) -> Expr s a -> Either (TypeError s a) (Expr s a) Source #
checkContext :: Context (Expr s X) -> Either (TypeError s X) () Source #
This function verifies that a custom context is well-formed so that type-checking will not loop
Note that typeWith
already calls checkContext
for you on the Context
that you supply
Types
type Typer a = forall s. a -> Expr s a Source #
Function that converts the value inside an Embed
constructor into a new
expression
Like Void
, except with a shorter inferred type
A structured type error that includes context
TypeError | |
|
newtype DetailedTypeError s a Source #
Newtype used to wrap error messages so that they render with a more detailed explanation of what went wrong
DetailedTypeError (TypeError s a) |
data TypeMessage s a Source #
The specific type error