{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Aeson.Schema.TH.Utils (
reifySchema,
lookupSchema,
loadSchema,
resolveSchemaType,
schemaVToTypeQ,
schemaTypeVToTypeQ,
) where
import Control.Applicative (empty)
import Control.Monad (forM)
import Data.Bifunctor (bimap)
import Language.Haskell.TH
import Data.Aeson.Schema.Internal (Object)
import Data.Aeson.Schema.Key (SchemaKey' (..), SchemaKeyV)
import Data.Aeson.Schema.Type (
Schema' (..),
SchemaObjectMapV,
SchemaType' (..),
SchemaTypeV,
SchemaV,
fromSchemaV,
toSchemaObjectV,
)
import Data.Aeson.Schema.Utils.Invariant (unreachable)
import Data.Aeson.Schema.Utils.NameLike (NameLike (..), resolveName)
reifySchema :: String -> Q SchemaV
reifySchema :: String -> Q SchemaV
reifySchema String
name = NameLike -> Q ReifiedSchema
lookupSchema (String -> NameLike
NameRef String
name) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReifiedSchema -> Q SchemaV
loadSchema
data ReifiedSchema = ReifiedSchema
{ ReifiedSchema -> Name
reifiedSchemaName :: Name
, ReifiedSchema -> TypeWithoutKinds
reifiedSchemaType :: TypeWithoutKinds
}
lookupSchema :: NameLike -> Q ReifiedSchema
lookupSchema :: NameLike -> Q ReifiedSchema
lookupSchema NameLike
nameLike = do
Name
name <- NameLike -> Q Name
lookupSchemaName NameLike
nameLike
Name -> TypeWithoutKinds -> ReifiedSchema
ReifiedSchema Name
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q TypeWithoutKinds
reifySchemaType Name
name
where
lookupSchemaName :: NameLike -> Q Name
lookupSchemaName = \case
NameRef String
name -> String -> Q (Maybe Name)
lookupTypeName String
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown schema: " forall a. [a] -> [a] -> [a]
++ String
name) forall (m :: * -> *) a. Monad m => a -> m a
return
NameTH Name
name -> forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
reifySchemaType :: Name -> Q TypeWithoutKinds
reifySchemaType :: Name -> Q TypeWithoutKinds
reifySchemaType Name
schemaName =
Name -> Q Info
reify Name
schemaName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TyConI (TySynD Name
_ [TyVarBndr ()]
_ (TypeWithoutKinds -> TypeWithoutKinds
stripKinds -> TypeWithoutKinds
ty))
| TypeWithoutKinds -> Bool
isPromotedSchema TypeWithoutKinds
ty ->
forall (m :: * -> *) a. Monad m => a -> m a
return TypeWithoutKinds
ty
| Just TypeWithoutKinds
inner <- TypeWithoutKinds -> Maybe TypeWithoutKinds
unwrapObject TypeWithoutKinds
ty
, TypeWithoutKinds -> Bool
isPromotedSchema TypeWithoutKinds
inner ->
forall (m :: * -> *) a. Monad m => a -> m a
return TypeWithoutKinds
inner
| Just (ConT Name
schemaName') <- TypeWithoutKinds -> Maybe TypeWithoutKinds
unwrapObject TypeWithoutKinds
ty ->
Name -> Q TypeWithoutKinds
reifySchemaType Name
schemaName'
Info
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
schemaName forall a. [a] -> [a] -> [a]
++ String
"' is not a Schema"
unwrapObject :: TypeWithoutKinds -> Maybe TypeWithoutKinds
unwrapObject :: TypeWithoutKinds -> Maybe TypeWithoutKinds
unwrapObject = \case
AppT (ConT Name
name) TypeWithoutKinds
inner | Name
name forall a. Eq a => a -> a -> Bool
== ''Object -> forall a. a -> Maybe a
Just TypeWithoutKinds
inner
TypeWithoutKinds
_ -> forall a. Maybe a
Nothing
isPromotedSchema :: TypeWithoutKinds -> Bool
isPromotedSchema :: TypeWithoutKinds -> Bool
isPromotedSchema = \case
AppT (PromotedT Name
name) TypeWithoutKinds
_ | Name
name forall a. Eq a => a -> a -> Bool
== 'Schema -> Bool
True
TypeWithoutKinds
_ -> Bool
False
loadSchema :: ReifiedSchema -> Q SchemaV
loadSchema :: ReifiedSchema -> Q SchemaV
loadSchema ReifiedSchema{TypeWithoutKinds
reifiedSchemaType :: TypeWithoutKinds
reifiedSchemaType :: ReifiedSchema -> TypeWithoutKinds
reifiedSchemaType} =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not parse schema: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeWithoutKinds
reifiedSchemaType) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TypeWithoutKinds -> Maybe SchemaV
parseSchema TypeWithoutKinds
reifiedSchemaType
where
parseSchema :: TypeWithoutKinds -> Maybe SchemaV
parseSchema :: TypeWithoutKinds -> Maybe SchemaV
parseSchema TypeWithoutKinds
ty = do
TypeWithoutKinds
schemaObjectType <- case TypeWithoutKinds
ty of
AppT (PromotedT Name
name) TypeWithoutKinds
schemaType | Name
name forall a. Eq a => a -> a -> Bool
== 'Schema -> forall (m :: * -> *) a. Monad m => a -> m a
return TypeWithoutKinds
schemaType
TypeWithoutKinds
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
forall s ty. SchemaObjectMap' s ty -> Schema' s ty
Schema forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe SchemaObjectMapV
parseSchemaObjectMap TypeWithoutKinds
schemaObjectType
parseSchemaObjectMap :: TypeWithoutKinds -> Maybe SchemaObjectMapV
parseSchemaObjectMap :: TypeWithoutKinds -> Maybe SchemaObjectMapV
parseSchemaObjectMap TypeWithoutKinds
schemaObjectType = do
[(TypeWithoutKinds, TypeWithoutKinds)]
schemaObjectListOfPairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeWithoutKinds -> Maybe (TypeWithoutKinds, TypeWithoutKinds)
typeToPair forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeWithoutKinds -> Maybe [TypeWithoutKinds]
typeToList TypeWithoutKinds
schemaObjectType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(TypeWithoutKinds, TypeWithoutKinds)]
schemaObjectListOfPairs forall a b. (a -> b) -> a -> b
$ \(TypeWithoutKinds
schemaKeyType, TypeWithoutKinds
schemaTypeType) -> do
SchemaKey' String
schemaKey <- TypeWithoutKinds -> Maybe (SchemaKey' String)
parseSchemaKey TypeWithoutKinds
schemaKeyType
SchemaType' String NameLike
schemaType <- TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType TypeWithoutKinds
schemaTypeType
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemaKey' String
schemaKey, SchemaType' String NameLike
schemaType)
parseSchemaKey :: TypeWithoutKinds -> Maybe SchemaKeyV
parseSchemaKey :: TypeWithoutKinds -> Maybe (SchemaKey' String)
parseSchemaKey = \case
AppT (PromotedT Name
ty) (LitT (StrTyLit String
key))
| Name
ty forall a. Eq a => a -> a -> Bool
== 'NormalKey -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. s -> SchemaKey' s
NormalKey String
key
| Name
ty forall a. Eq a => a -> a -> Bool
== 'PhantomKey -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. s -> SchemaKey' s
PhantomKey String
key
TypeWithoutKinds
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
parseSchemaType :: TypeWithoutKinds -> Maybe SchemaTypeV
parseSchemaType :: TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType = \case
AppT (PromotedT Name
name) (ConT Name
inner)
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaScalar -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s ty. ty -> SchemaType' s ty
SchemaScalar forall a b. (a -> b) -> a -> b
$ Name -> NameLike
NameTH Name
inner
AppT (PromotedT Name
name) TypeWithoutKinds
inner
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaMaybe -> forall s ty. SchemaType' s ty -> SchemaType' s ty
SchemaMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType TypeWithoutKinds
inner
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaTry -> forall s ty. SchemaType' s ty -> SchemaType' s ty
SchemaTry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType TypeWithoutKinds
inner
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaList -> forall s ty. SchemaType' s ty -> SchemaType' s ty
SchemaList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType TypeWithoutKinds
inner
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaUnion -> do
[TypeWithoutKinds]
schemas <- TypeWithoutKinds -> Maybe [TypeWithoutKinds]
typeToList TypeWithoutKinds
inner
forall s ty. [SchemaType' s ty] -> SchemaType' s ty
SchemaUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TypeWithoutKinds -> Maybe (SchemaType' String NameLike)
parseSchemaType [TypeWithoutKinds]
schemas
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaObject -> forall s ty. SchemaObjectMap' s ty -> SchemaType' s ty
SchemaObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe SchemaObjectMapV
parseSchemaObjectMap TypeWithoutKinds
inner
AppT (PromotedT Name
name) (AppT (PromotedT Name
right) (ConT Name
inner))
| Name
name forall a. Eq a => a -> a -> Bool
== 'SchemaInclude
, Name
right forall a. Eq a => a -> a -> Bool
== 'Right ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s ty. Either ty (Schema' s ty) -> SchemaType' s ty
SchemaInclude forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Name -> NameLike
NameTH Name
inner
TypeWithoutKinds
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
resolveSchemaType :: SchemaTypeV -> Q SchemaTypeV
resolveSchemaType :: SchemaType' String NameLike -> Q (SchemaType' String NameLike)
resolveSchemaType = \case
SchemaInclude (Left NameLike
name) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SchemaV -> SchemaType' String NameLike
toSchemaObjectV forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReifiedSchema -> Q SchemaV
loadSchema forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NameLike -> Q ReifiedSchema
lookupSchema NameLike
name
SchemaInclude (Right SchemaV
_) -> forall a. String -> a
unreachable String
"Found 'SchemaInclude Right' when resolving schema type"
SchemaType' String NameLike
schemaType -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SchemaType' String NameLike
schemaType
schemaVToTypeQ :: SchemaV -> TypeQ
schemaVToTypeQ :: SchemaV -> Q TypeWithoutKinds
schemaVToTypeQ = forall (m :: * -> *).
Quote m =>
m TypeWithoutKinds -> m TypeWithoutKinds -> m TypeWithoutKinds
appT [t|'Schema|] forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaObjectMapV -> Q TypeWithoutKinds
schemaObjectMapVToTypeQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaV -> SchemaObjectMapV
fromSchemaV
schemaObjectMapVToTypeQ :: SchemaObjectMapV -> TypeQ
schemaObjectMapVToTypeQ :: SchemaObjectMapV -> Q TypeWithoutKinds
schemaObjectMapVToTypeQ = [Q TypeWithoutKinds] -> Q TypeWithoutKinds
promotedListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (SchemaKey' String, SchemaType' String NameLike)
-> Q TypeWithoutKinds
schemaObjectPairVToTypeQ
where
schemaObjectPairVToTypeQ :: (SchemaKeyV, SchemaTypeV) -> TypeQ
schemaObjectPairVToTypeQ :: (SchemaKey' String, SchemaType' String NameLike)
-> Q TypeWithoutKinds
schemaObjectPairVToTypeQ = (Q TypeWithoutKinds, Q TypeWithoutKinds) -> Q TypeWithoutKinds
promotedPairT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SchemaKey' String -> Q TypeWithoutKinds
schemaKeyVToTypeQ SchemaType' String NameLike -> Q TypeWithoutKinds
schemaTypeVToTypeQ
schemaKeyVToTypeQ :: SchemaKeyV -> TypeQ
schemaKeyVToTypeQ :: SchemaKey' String -> Q TypeWithoutKinds
schemaKeyVToTypeQ = \case
NormalKey String
key -> [t|'NormalKey $(litT $ strTyLit key)|]
PhantomKey String
key -> [t|'PhantomKey $(litT $ strTyLit key)|]
schemaTypeVToTypeQ :: SchemaTypeV -> TypeQ
schemaTypeVToTypeQ :: SchemaType' String NameLike -> Q TypeWithoutKinds
schemaTypeVToTypeQ = \case
SchemaScalar NameLike
name -> [t|'SchemaScalar $(resolveName name >>= conT)|]
SchemaMaybe SchemaType' String NameLike
inner -> [t|'SchemaMaybe $(schemaTypeVToTypeQ inner)|]
SchemaTry SchemaType' String NameLike
inner -> [t|'SchemaTry $(schemaTypeVToTypeQ inner)|]
SchemaList SchemaType' String NameLike
inner -> [t|'SchemaList $(schemaTypeVToTypeQ inner)|]
SchemaUnion [SchemaType' String NameLike]
schemas -> [t|'SchemaUnion $(promotedListT $ map schemaTypeVToTypeQ schemas)|]
SchemaObject SchemaObjectMapV
pairs -> [t|'SchemaObject $(schemaObjectMapVToTypeQ pairs)|]
SchemaInclude (Left NameLike
name) -> [t|'SchemaInclude ('Right $(conT . reifiedSchemaName =<< lookupSchema name))|]
SchemaInclude (Right SchemaV
_) -> forall a. String -> a
unreachable String
"Found 'SchemaInclude Right' when converting to TypeQ"
type TypeWithoutKinds = Type
stripKinds :: Type -> TypeWithoutKinds
stripKinds :: TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty =
case TypeWithoutKinds
ty of
SigT TypeWithoutKinds
ty1 TypeWithoutKinds
_ -> TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1
AppKindT TypeWithoutKinds
ty1 TypeWithoutKinds
_ -> TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1
ForallT [TyVarBndr Specificity]
tyVars [TypeWithoutKinds]
ctx TypeWithoutKinds
ty1 -> [TyVarBndr Specificity]
-> [TypeWithoutKinds] -> TypeWithoutKinds -> TypeWithoutKinds
ForallT [TyVarBndr Specificity]
tyVars [TypeWithoutKinds]
ctx (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1)
ForallVisT [TyVarBndr ()]
tyVars TypeWithoutKinds
ty1 -> [TyVarBndr ()] -> TypeWithoutKinds -> TypeWithoutKinds
ForallVisT [TyVarBndr ()]
tyVars (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1)
AppT TypeWithoutKinds
ty1 TypeWithoutKinds
ty2 -> TypeWithoutKinds -> TypeWithoutKinds -> TypeWithoutKinds
AppT (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1) (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty2)
InfixT TypeWithoutKinds
ty1 Name
name TypeWithoutKinds
ty2 -> TypeWithoutKinds -> Name -> TypeWithoutKinds -> TypeWithoutKinds
InfixT (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1) Name
name (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty2)
UInfixT TypeWithoutKinds
ty1 Name
name TypeWithoutKinds
ty2 -> TypeWithoutKinds -> Name -> TypeWithoutKinds -> TypeWithoutKinds
UInfixT (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1) Name
name (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty2)
#if MIN_VERSION_template_haskell(2,19,0)
PromotedInfixT ty1 name ty2 -> PromotedInfixT (stripKinds ty1) name (stripKinds ty2)
PromotedUInfixT ty1 name ty2 -> PromotedUInfixT (stripKinds ty1) name (stripKinds ty2)
#endif
ParensT TypeWithoutKinds
ty1 -> TypeWithoutKinds -> TypeWithoutKinds
ParensT (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1)
ImplicitParamT String
str TypeWithoutKinds
ty1 -> String -> TypeWithoutKinds -> TypeWithoutKinds
ImplicitParamT String
str (TypeWithoutKinds -> TypeWithoutKinds
stripKinds TypeWithoutKinds
ty1)
VarT Name
_ -> TypeWithoutKinds
ty
ConT Name
_ -> TypeWithoutKinds
ty
PromotedT Name
_ -> TypeWithoutKinds
ty
TupleT Int
_ -> TypeWithoutKinds
ty
UnboxedTupleT Int
_ -> TypeWithoutKinds
ty
UnboxedSumT Int
_ -> TypeWithoutKinds
ty
TypeWithoutKinds
ArrowT -> TypeWithoutKinds
ty
#if MIN_VERSION_template_haskell(2,17,0)
TypeWithoutKinds
MulArrowT -> TypeWithoutKinds
ty
#endif
TypeWithoutKinds
EqualityT -> TypeWithoutKinds
ty
TypeWithoutKinds
ListT -> TypeWithoutKinds
ty
PromotedTupleT Int
_ -> TypeWithoutKinds
ty
TypeWithoutKinds
PromotedNilT -> TypeWithoutKinds
ty
TypeWithoutKinds
PromotedConsT -> TypeWithoutKinds
ty
TypeWithoutKinds
StarT -> TypeWithoutKinds
ty
TypeWithoutKinds
ConstraintT -> TypeWithoutKinds
ty
LitT TyLit
_ -> TypeWithoutKinds
ty
TypeWithoutKinds
WildCardT -> TypeWithoutKinds
ty
typeToList :: TypeWithoutKinds -> Maybe [TypeWithoutKinds]
typeToList :: TypeWithoutKinds -> Maybe [TypeWithoutKinds]
typeToList = \case
TypeWithoutKinds
PromotedNilT -> forall a. a -> Maybe a
Just []
AppT (AppT TypeWithoutKinds
PromotedConsT TypeWithoutKinds
x) TypeWithoutKinds
xs -> (TypeWithoutKinds
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeWithoutKinds -> Maybe [TypeWithoutKinds]
typeToList TypeWithoutKinds
xs
TypeWithoutKinds
_ -> forall a. Maybe a
Nothing
typeToPair :: TypeWithoutKinds -> Maybe (TypeWithoutKinds, TypeWithoutKinds)
typeToPair :: TypeWithoutKinds -> Maybe (TypeWithoutKinds, TypeWithoutKinds)
typeToPair = \case
AppT (AppT (PromotedTupleT Int
2) TypeWithoutKinds
a) TypeWithoutKinds
b -> forall a. a -> Maybe a
Just (TypeWithoutKinds
a, TypeWithoutKinds
b)
TypeWithoutKinds
_ -> forall a. Maybe a
Nothing
promotedListT :: [TypeQ] -> TypeQ
promotedListT :: [Q TypeWithoutKinds] -> Q TypeWithoutKinds
promotedListT = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *).
Quote m =>
m TypeWithoutKinds -> m TypeWithoutKinds -> m TypeWithoutKinds
consT forall (m :: * -> *). Quote m => m TypeWithoutKinds
promotedNilT
where
consT :: m TypeWithoutKinds -> m TypeWithoutKinds -> m TypeWithoutKinds
consT m TypeWithoutKinds
x m TypeWithoutKinds
xs = forall (m :: * -> *).
Quote m =>
m TypeWithoutKinds -> m TypeWithoutKinds -> m TypeWithoutKinds
appT (forall (m :: * -> *).
Quote m =>
m TypeWithoutKinds -> m TypeWithoutKinds -> m TypeWithoutKinds
appT forall (m :: * -> *). Quote m => m TypeWithoutKinds
promotedConsT m TypeWithoutKinds
x) m TypeWithoutKinds
xs
promotedPairT :: (TypeQ, TypeQ) -> TypeQ
promotedPairT :: (Q TypeWithoutKinds, Q TypeWithoutKinds) -> Q TypeWithoutKinds
promotedPairT (Q TypeWithoutKinds
a, Q TypeWithoutKinds
b) = [t|'($a, $b)|]