Copyright | (C) 2018 Ryan Scott |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | Ryan Scott |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Defines a drop-in replacement for TypeError
(from GHC.TypeLits)
that can be used at the value level as well. Since this is a drop-in
replacement, it is not recommended to import all of GHC.TypeLits
and Data.Singletons.TypeError at the same time, as many of the definitons
in the latter deliberately clash with the former.
Synopsis
- type family TypeError a where ...
- sTypeError :: HasCallStack => Sing err -> Sing (TypeError err)
- typeError :: HasCallStack => ErrorMessage -> a
- data ErrorMessage' s
- = Text s
- | forall t. ShowType t
- | (ErrorMessage' s) :<>: (ErrorMessage' s)
- | (ErrorMessage' s) :$$: (ErrorMessage' s)
- type ErrorMessage = ErrorMessage' Text
- type PErrorMessage = ErrorMessage' Symbol
- type family Sing
- data SErrorMessage em where
- SText :: Sing t -> SErrorMessage ('Text t)
- SShowType :: Sing ty -> SErrorMessage ('ShowType ty)
- (:%<>:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 :<>: e2)
- (:%$$:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 :$$: e2)
- type family ConvertPErrorMessage a where ...
- showErrorMessage :: ErrorMessage -> String
- data TextSym0 a6989586621681349583
- type TextSym1 (a6989586621681349583 :: s) = 'Text a6989586621681349583 :: ErrorMessage' (s :: Type)
- data ShowTypeSym0 a6989586621681349585
- type ShowTypeSym1 (a6989586621681349585 :: t) = 'ShowType a6989586621681349585 :: ErrorMessage' (s :: Type)
- data (:<>:@#@$) a6989586621681349587
- data a6989586621681349587 :<>:@#@$$ a6989586621681349588
- type (:<>:@#@$$$) (a6989586621681349587 :: ErrorMessage' s) (a6989586621681349588 :: ErrorMessage' s) = '(:<>:) a6989586621681349587 a6989586621681349588 :: ErrorMessage' (s :: Type)
- data (:$$:@#@$) a6989586621681349590
- data a6989586621681349590 :$$:@#@$$ a6989586621681349591
- type (:$$:@#@$$$) (a6989586621681349590 :: ErrorMessage' s) (a6989586621681349591 :: ErrorMessage' s) = '(:$$:) a6989586621681349590 a6989586621681349591 :: ErrorMessage' (s :: Type)
- data TypeErrorSym0 a6989586621681349593
- type TypeErrorSym1 (a6989586621681349593 :: PErrorMessage) = TypeError a6989586621681349593 :: a
Documentation
sTypeError :: HasCallStack => Sing err -> Sing (TypeError err) Source #
typeError :: HasCallStack => ErrorMessage -> a Source #
data ErrorMessage' s Source #
A description of a custom type error.
This is a variation on ErrorMessage
that is parameterized over what
text type is used in the Text
constructor. Instantiating it with
Text
gives you ErrorMessage
, and instantiating it with Symbol
gives you PErrorMessage
.
Text s | Show the text as is. |
forall t. ShowType t | Pretty print the type.
|
(ErrorMessage' s) :<>: (ErrorMessage' s) infixl 6 | Put two pieces of error message next to each other. |
(ErrorMessage' s) :$$: (ErrorMessage' s) infixl 5 | Stack two pieces of error message on top of each other. |
Instances
type ErrorMessage = ErrorMessage' Text Source #
A value-level ErrorMessage
` which uses Text
as its text type.
type PErrorMessage = ErrorMessage' Symbol Source #
A type-level ErrorMessage
` which uses Symbol
as its text kind.
The singleton kind-indexed type family.
Instances
data SErrorMessage em where Source #
SText :: Sing t -> SErrorMessage ('Text t) | |
SShowType :: Sing ty -> SErrorMessage ('ShowType ty) | |
(:%<>:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 :<>: e2) infixl 6 | |
(:%$$:) :: Sing e1 -> Sing e2 -> SErrorMessage (e1 :$$: e2) infixl 5 |
type family ConvertPErrorMessage a where ... Source #
Convert a PErrorMessage
to a ErrorMessage
from GHC.TypeLits.
ConvertPErrorMessage ('Text t) = 'Text t | |
ConvertPErrorMessage ('ShowType ty) = 'ShowType ty | |
ConvertPErrorMessage (e1 :<>: e2) = ConvertPErrorMessage e1 :<>: ConvertPErrorMessage e2 | |
ConvertPErrorMessage (e1 :$$: e2) = ConvertPErrorMessage e1 :$$: ConvertPErrorMessage e2 |
showErrorMessage :: ErrorMessage -> String Source #
Convert an ErrorMessage
into a human-readable String
.
Defunctionalization symbols
data TextSym0 a6989586621681349583 Source #
Instances
SingI (TextSym0 :: TyFun Symbol (ErrorMessage' Symbol) -> Type) Source # | |
SuppressUnusedWarnings (TextSym0 :: TyFun s (ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply (TextSym0 :: TyFun s (ErrorMessage' s) -> Type) (a6989586621681349583 :: s) Source # | |
Defined in Data.Singletons.TypeError |
type TextSym1 (a6989586621681349583 :: s) = 'Text a6989586621681349583 :: ErrorMessage' (s :: Type) Source #
data ShowTypeSym0 a6989586621681349585 Source #
Instances
SingI (ShowTypeSym0 :: TyFun t (ErrorMessage' Symbol) -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing ShowTypeSym0 Source # | |
SuppressUnusedWarnings (ShowTypeSym0 :: TyFun t (ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply (ShowTypeSym0 :: TyFun t (ErrorMessage' s) -> Type) (a6989586621681349585 :: t) Source # | |
Defined in Data.Singletons.TypeError type Apply (ShowTypeSym0 :: TyFun t (ErrorMessage' s) -> Type) (a6989586621681349585 :: t) = ShowTypeSym1 a6989586621681349585 :: ErrorMessage' s |
type ShowTypeSym1 (a6989586621681349585 :: t) = 'ShowType a6989586621681349585 :: ErrorMessage' (s :: Type) Source #
data (:<>:@#@$) a6989586621681349587 infixl 6 Source #
Instances
SingI ((:<>:@#@$) :: TyFun (ErrorMessage' Symbol) (ErrorMessage' Symbol ~> ErrorMessage' Symbol) -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing (:<>:@#@$) Source # | |
SuppressUnusedWarnings ((:<>:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply ((:<>:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) (a6989586621681349587 :: ErrorMessage' s) Source # | |
Defined in Data.Singletons.TypeError type Apply ((:<>:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) (a6989586621681349587 :: ErrorMessage' s) = (:<>:@#@$$) a6989586621681349587 |
data a6989586621681349587 :<>:@#@$$ a6989586621681349588 infixl 6 Source #
Instances
SingI x => SingI ((:<>:@#@$$) x :: TyFun (ErrorMessage' Symbol) (ErrorMessage' Symbol) -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing ((:<>:@#@$$) x) Source # | |
SuppressUnusedWarnings ((:<>:@#@$$) a6989586621681349587 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply ((:<>:@#@$$) a6989586621681349587 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) (a6989586621681349588 :: ErrorMessage' s) Source # | |
Defined in Data.Singletons.TypeError type Apply ((:<>:@#@$$) a6989586621681349587 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) (a6989586621681349588 :: ErrorMessage' s) = a6989586621681349587 :<>:@#@$$$ a6989586621681349588 |
type (:<>:@#@$$$) (a6989586621681349587 :: ErrorMessage' s) (a6989586621681349588 :: ErrorMessage' s) = '(:<>:) a6989586621681349587 a6989586621681349588 :: ErrorMessage' (s :: Type) infixl 6 Source #
data (:$$:@#@$) a6989586621681349590 infixl 5 Source #
Instances
SingI ((:$$:@#@$) :: TyFun (ErrorMessage' Symbol) (ErrorMessage' Symbol ~> ErrorMessage' Symbol) -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing (:$$:@#@$) Source # | |
SuppressUnusedWarnings ((:$$:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply ((:$$:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) (a6989586621681349590 :: ErrorMessage' s) Source # | |
Defined in Data.Singletons.TypeError type Apply ((:$$:@#@$) :: TyFun (ErrorMessage' s) (ErrorMessage' s ~> ErrorMessage' s) -> Type) (a6989586621681349590 :: ErrorMessage' s) = (:$$:@#@$$) a6989586621681349590 |
data a6989586621681349590 :$$:@#@$$ a6989586621681349591 infixl 5 Source #
Instances
SingI x => SingI ((:$$:@#@$$) x :: TyFun (ErrorMessage' Symbol) (ErrorMessage' Symbol) -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing ((:$$:@#@$$) x) Source # | |
SuppressUnusedWarnings ((:$$:@#@$$) a6989586621681349590 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply ((:$$:@#@$$) a6989586621681349590 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) (a6989586621681349591 :: ErrorMessage' s) Source # | |
Defined in Data.Singletons.TypeError type Apply ((:$$:@#@$$) a6989586621681349590 :: TyFun (ErrorMessage' s) (ErrorMessage' s) -> Type) (a6989586621681349591 :: ErrorMessage' s) = a6989586621681349590 :$$:@#@$$$ a6989586621681349591 |
type (:$$:@#@$$$) (a6989586621681349590 :: ErrorMessage' s) (a6989586621681349591 :: ErrorMessage' s) = '(:$$:) a6989586621681349590 a6989586621681349591 :: ErrorMessage' (s :: Type) infixl 5 Source #
data TypeErrorSym0 a6989586621681349593 Source #
Instances
SingI (TypeErrorSym0 :: TyFun PErrorMessage a -> Type) Source # | |
Defined in Data.Singletons.TypeError sing :: Sing TypeErrorSym0 Source # | |
SuppressUnusedWarnings (TypeErrorSym0 :: TyFun PErrorMessage a -> Type) Source # | |
Defined in Data.Singletons.TypeError suppressUnusedWarnings :: () Source # | |
type Apply (TypeErrorSym0 :: TyFun PErrorMessage k2 -> Type) (a6989586621681349593 :: PErrorMessage) Source # | |
Defined in Data.Singletons.TypeError type Apply (TypeErrorSym0 :: TyFun PErrorMessage k2 -> Type) (a6989586621681349593 :: PErrorMessage) = TypeErrorSym1 a6989586621681349593 :: k2 |
type TypeErrorSym1 (a6989586621681349593 :: PErrorMessage) = TypeError a6989586621681349593 :: a Source #