{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Utils
( conNameProxy,
isRecordProxy,
selNameProxy,
TypeRep (..),
ConsRep (..),
TypeConstraint (..),
FieldRep (..),
isEmptyConstraint,
DataType (..),
ConRep (..),
toRep,
toValue,
isUnionRef,
fieldTypeName,
unpackMonad,
deriveTypeRef,
symbolName,
withKind,
toFieldRes,
)
where
import Data.Morpheus.Server.Deriving.Utils.Kinded
( CategoryValue (..),
KindedProxy (KindedProxy),
kinded,
)
import Data.Morpheus.Server.Types.GQLType
( GQLType (..),
GQLTypeOptions (..),
TypeData (..),
defaultTypeOptions,
__typeData,
)
import Data.Morpheus.Types.Internal.AST
( FieldName,
TypeCategory,
TypeName,
TypeRef (..),
packName,
)
import Data.Text
( pack,
)
import qualified Data.Text as T
import GHC.Generics
( C,
Constructor,
D,
Datatype,
Generic (..),
K1 (..),
M1 (..),
Meta,
Rec0,
S,
Selector,
U1 (..),
conIsRecord,
conName,
selName,
(:*:) (..),
(:+:) (..),
)
import GHC.TypeLits
import Relude hiding (undefined)
import Prelude (undefined)
conNameProxy :: forall f (c :: Meta). Constructor c => GQLTypeOptions -> f c -> TypeName
conNameProxy :: forall (f :: Meta -> *) (c :: Meta).
Constructor c =>
GQLTypeOptions -> f c -> TypeName
conNameProxy GQLTypeOptions
options f c
_ =
forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ GQLTypeOptions -> String -> String
constructorTagModifier GQLTypeOptions
options forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall a. HasCallStack => a
undefined :: M1 C c U1 a)
selNameProxy :: forall f (s :: Meta). Selector s => GQLTypeOptions -> f s -> FieldName
selNameProxy :: forall (f :: Meta -> *) (s :: Meta).
Selector s =>
GQLTypeOptions -> f s -> FieldName
selNameProxy GQLTypeOptions
options f s
_ =
String -> FieldName
fromHaskellName forall a b. (a -> b) -> a -> b
$
GQLTypeOptions -> String -> String
fieldLabelModifier GQLTypeOptions
options forall a b. (a -> b) -> a -> b
$
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall a. HasCallStack => a
undefined :: M1 S s f a)
fromHaskellName :: String -> FieldName
fromHaskellName :: String -> FieldName
fromHaskellName String
hsName
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
hsName) Bool -> Bool -> Bool
&& (Text -> Char
T.last Text
name forall a. Eq a => a -> a -> Bool
== Char
'\'') = forall a (t :: NAME). NamePacking a => a -> Name t
packName (Text -> Text
T.init Text
name)
| Bool
otherwise = forall a (t :: NAME). NamePacking a => a -> Name t
packName Text
name
where
name :: Text
name = String -> Text
T.pack String
hsName
{-# INLINE fromHaskellName #-}
isRecordProxy :: forall f (c :: Meta). Constructor c => f c -> Bool
isRecordProxy :: forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool
isRecordProxy f c
_ = forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord (forall a. HasCallStack => a
undefined :: (M1 C c f a))
newtype TypeConstraint (c :: Type -> Constraint) (v :: Type) (f :: Type -> Type) = TypeConstraint
{ forall (c :: * -> Constraint) v (f :: * -> *).
TypeConstraint c v f -> forall a. c a => f a -> v
typeConstraint :: forall a. c a => f a -> v
}
toRep ::
forall kinded constraint value (a :: Type) (kind :: TypeCategory).
(GQLType a, CategoryValue kind, TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Proxy ->
kinded kind a ->
[ConsRep value]
toRep :: forall (kinded :: TypeCategory -> * -> *)
(constraint :: * -> Constraint) value a (kind :: TypeCategory).
(GQLType a, CategoryValue kind,
TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Proxy
-> kinded kind a -> [ConsRep value]
toRep TypeConstraint constraint value Proxy
f kinded kind a
proxy = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [ConsRep v]
typeRep (forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions kinded kind a
proxy GQLTypeOptions
defaultTypeOptions, forall {k} (t :: k). Proxy t
Proxy @kind, TypeConstraint constraint value Proxy
f) (forall {k} (t :: k). Proxy t
Proxy @(Rep a))
toValue ::
forall proxy (kind :: TypeCategory) constraint value (a :: Type).
(GQLType a, CategoryValue kind, Generic a, TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Identity ->
proxy kind ->
a ->
DataType value
toValue :: forall (proxy :: TypeCategory -> *) (kind :: TypeCategory)
(constraint :: * -> Constraint) value a.
(GQLType a, CategoryValue kind, Generic a,
TypeRep constraint value (Rep a)) =>
TypeConstraint constraint value Identity
-> proxy kind -> a -> DataType value
toValue TypeConstraint constraint value Identity
f proxy kind
proxy = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (TypeName
typeName, GQLTypeOptions
options, proxy kind
proxy, TypeConstraint constraint value Identity
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
where
typeName :: TypeName
typeName = TypeData -> TypeName
gqlTypeName forall a b. (a -> b) -> a -> b
$ forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy kind a)
options :: GQLTypeOptions
options = forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions (forall {k} (t :: k). Proxy t
Proxy @a) GQLTypeOptions
defaultTypeOptions
class TypeRep (c :: Type -> Constraint) (v :: Type) f where
typeRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Proxy) -> proxy f -> [ConsRep v]
toTypeRep :: CategoryValue kind => (TypeName, GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Identity) -> f a -> DataType v
instance (Datatype d, TypeRep c v f) => TypeRep c v (M1 D d f) where
typeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (M1 D d f) -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun proxy (M1 D d f)
_ = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun (forall {k} (t :: k). Proxy t
Proxy @f)
toTypeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> M1 D d f a -> DataType v
toTypeRep fun :: (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
fun@(TypeName
dataTypeName, GQLTypeOptions
_, kinProxy kind
_, TypeConstraint c v Identity
_) (M1 f a
src) = (forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
fun f a
src) {TypeName
dataTypeName :: TypeName
dataTypeName :: TypeName
dataTypeName}
instance (TypeRep c v a, TypeRep c v b) => TypeRep c v (a :+: b) where
typeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (a :+: b) -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun proxy (a :+: b)
_ = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun (forall {k} (t :: k). Proxy t
Proxy @b)
toTypeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> (:+:) a b a -> DataType v
toTypeRep (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
f (L1 a a
x) = (forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
f a a
x) {tyIsUnion :: Bool
tyIsUnion = Bool
True}
toTypeRep (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
f (R1 b a
x) = (forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint c v Identity)
f b a
x) {tyIsUnion :: Bool
tyIsUnion = Bool
True}
instance (ConRep con v f, Constructor c) => TypeRep con v (M1 C c f) where
typeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint con v Proxy)
-> proxy (M1 C c f) -> [ConsRep v]
typeRep f :: (GQLTypeOptions, kinProxy kind, TypeConstraint con v Proxy)
f@(GQLTypeOptions
opt, kinProxy kind
_, TypeConstraint con v Proxy
_) proxy (M1 C c f)
_ = [forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt (forall {k} (t :: k). Proxy t
Proxy @c) (forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint con v Proxy)
f (forall {k} (t :: k). Proxy t
Proxy @f))]
toTypeRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(TypeName, GQLTypeOptions, kinProxy kind,
TypeConstraint con v Identity)
-> M1 C c f a -> DataType v
toTypeRep (TypeName
_, GQLTypeOptions
opt, kinProxy kind
x, TypeConstraint con v Identity
y) (M1 f a
src) =
DataType
{ dataTypeName :: TypeName
dataTypeName = TypeName
"",
tyIsUnion :: Bool
tyIsUnion = Bool
False,
tyCons :: ConsRep v
tyCons = forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt (forall {k} (t :: k). Proxy t
Proxy @c) (forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> [FieldRep v]
toFieldRep (GQLTypeOptions
opt, kinProxy kind
x, TypeConstraint con v Identity
y) f a
src)
}
deriveConsRep ::
Constructor (c :: Meta) =>
GQLTypeOptions ->
f c ->
[FieldRep v] ->
ConsRep v
deriveConsRep :: forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt f c
proxy [FieldRep v]
fields =
ConsRep
{ consName :: TypeName
consName = forall (f :: Meta -> *) (c :: Meta).
Constructor c =>
GQLTypeOptions -> f c -> TypeName
conNameProxy GQLTypeOptions
opt f c
proxy,
[FieldRep v]
consFields :: [FieldRep v]
consFields :: [FieldRep v]
consFields
}
where
consFields :: [FieldRep v]
consFields
| forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool
isRecordProxy f c
proxy = [FieldRep v]
fields
| Bool
otherwise = forall a. [FieldRep a] -> [FieldRep a]
enumerate [FieldRep v]
fields
class ConRep (c :: Type -> Constraint) (v :: Type) f where
conRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Proxy) -> proxy f -> [FieldRep v]
toFieldRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Identity) -> f a -> [FieldRep v]
instance (ConRep c v a, ConRep c v b) => ConRep c v (a :*: b) where
conRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (a :*: b) -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun proxy (a :*: b)
_ = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy f -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun (forall {k} (t :: k). Proxy t
Proxy @b)
toFieldRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> (:*:) a b a -> [FieldRep v]
toFieldRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun (a a
a :*: b a
b) = forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> [FieldRep v]
toFieldRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun a a
a forall a. Semigroup a => a -> a -> a
<> forall {k} (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(ConRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> [FieldRep v]
toFieldRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun b a
b
instance (Selector s, GQLType a, c a) => ConRep c v (M1 S s (Rec0 a)) where
conRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (M1 S s (Rec0 a)) -> [FieldRep v]
conRep (GQLTypeOptions
opt, kinProxy kind
kind, TypeConstraint forall a. c a => Proxy a -> v
f) proxy (M1 S s (Rec0 a))
_ = [forall (proxy :: Meta -> *) (selector :: Meta)
(kindedProxy :: TypeCategory -> * -> *) a v (kind :: TypeCategory).
(Selector selector, GQLType a, CategoryValue kind) =>
GQLTypeOptions
-> proxy selector -> kindedProxy kind a -> v -> FieldRep v
deriveFieldRep GQLTypeOptions
opt (forall {k} (t :: k). Proxy t
Proxy @s) (forall {k1} {k2} (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *)
(a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded kinProxy kind
kind (forall {k} (t :: k). Proxy t
Proxy @a)) (forall a. c a => Proxy a -> v
f forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a)]
toFieldRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> M1 S s (Rec0 a) a -> [FieldRep v]
toFieldRep (GQLTypeOptions
opt, kinProxy kind
kind, TypeConstraint forall a. c a => Identity a -> v
f) (M1 (K1 a
src)) = [forall (proxy :: Meta -> *) (selector :: Meta)
(kindedProxy :: TypeCategory -> * -> *) a v (kind :: TypeCategory).
(Selector selector, GQLType a, CategoryValue kind) =>
GQLTypeOptions
-> proxy selector -> kindedProxy kind a -> v -> FieldRep v
deriveFieldRep GQLTypeOptions
opt (forall {k} (t :: k). Proxy t
Proxy @s) (forall {k1} {k2} (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *)
(a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded kinProxy kind
kind (forall {k} (t :: k). Proxy t
Proxy @a)) (forall a. c a => Identity a -> v
f (forall a. a -> Identity a
Identity a
src))]
deriveFieldRep ::
forall
proxy
(selector :: Meta)
(kindedProxy :: TypeCategory -> Type -> Type)
a
v
(kind :: TypeCategory).
( Selector selector,
GQLType a,
CategoryValue kind
) =>
GQLTypeOptions ->
proxy selector ->
kindedProxy kind a ->
v ->
FieldRep v
deriveFieldRep :: forall (proxy :: Meta -> *) (selector :: Meta)
(kindedProxy :: TypeCategory -> * -> *) a v (kind :: TypeCategory).
(Selector selector, GQLType a, CategoryValue kind) =>
GQLTypeOptions
-> proxy selector -> kindedProxy kind a -> v -> FieldRep v
deriveFieldRep GQLTypeOptions
opt proxy selector
pSel kindedProxy kind a
kindedProxy v
v =
FieldRep
{ fieldSelector :: FieldName
fieldSelector = forall (f :: Meta -> *) (s :: Meta).
Selector s =>
GQLTypeOptions -> f s -> FieldName
selNameProxy GQLTypeOptions
opt proxy selector
pSel,
fieldTypeRef :: TypeRef
fieldTypeRef = forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeRef
deriveTypeRef kindedProxy kind a
kindedProxy,
fieldValue :: v
fieldValue = v
v
}
deriveTypeRef :: (GQLType a, CategoryValue kind) => kinded kind a -> TypeRef
deriveTypeRef :: forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeRef
deriveTypeRef kinded kind a
kindedProxy =
TypeRef
{ typeConName :: TypeName
typeConName = TypeName
gqlTypeName,
typeWrappers :: TypeWrapper
typeWrappers = TypeWrapper
gqlWrappers
}
where
TypeData {TypeName
gqlTypeName :: TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName, TypeWrapper
gqlWrappers :: TypeData -> TypeWrapper
gqlWrappers :: TypeWrapper
gqlWrappers} = forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
kindedProxy
instance ConRep c v U1 where
conRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(proxy :: (k -> *) -> *).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy U1 -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
_ proxy U1
_ = []
toFieldRep :: forall (kind :: TypeCategory) (kinProxy :: TypeCategory -> *)
(a :: k).
CategoryValue kind =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> U1 a -> [FieldRep v]
toFieldRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
_ U1 a
_ = []
data DataType (v :: Type) = DataType
{ forall v. DataType v -> TypeName
dataTypeName :: TypeName,
forall v. DataType v -> Bool
tyIsUnion :: Bool,
forall v. DataType v -> ConsRep v
tyCons :: ConsRep v
}
data ConsRep (v :: Type) = ConsRep
{ forall v. ConsRep v -> TypeName
consName :: TypeName,
forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep v]
}
data FieldRep (a :: Type) = FieldRep
{ forall a. FieldRep a -> FieldName
fieldSelector :: FieldName,
forall a. FieldRep a -> TypeRef
fieldTypeRef :: TypeRef,
forall a. FieldRep a -> a
fieldValue :: a
}
deriving (forall a b. a -> FieldRep b -> FieldRep a
forall a b. (a -> b) -> FieldRep a -> FieldRep b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FieldRep b -> FieldRep a
$c<$ :: forall a b. a -> FieldRep b -> FieldRep a
fmap :: forall a b. (a -> b) -> FieldRep a -> FieldRep b
$cfmap :: forall a b. (a -> b) -> FieldRep a -> FieldRep b
Functor)
toFieldRes :: FieldRep (m a) -> (FieldName, m a)
toFieldRes :: forall {k} (m :: k -> *) (a :: k).
FieldRep (m a) -> (FieldName, m a)
toFieldRes FieldRep {FieldName
fieldSelector :: FieldName
fieldSelector :: forall a. FieldRep a -> FieldName
fieldSelector, m a
fieldValue :: m a
fieldValue :: forall a. FieldRep a -> a
fieldValue} = (FieldName
fieldSelector, m a
fieldValue)
unpackMonadFromField :: Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField :: forall (m :: * -> *) a. Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField FieldRep {m a
TypeRef
FieldName
fieldValue :: m a
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
fieldValue :: forall a. FieldRep a -> a
fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldSelector :: forall a. FieldRep a -> FieldName
..} = do
a
cont <- m a
fieldValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldRep {fieldValue :: a
fieldValue = a
cont, TypeRef
FieldName
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
..})
unpackMonadFromCons :: Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons :: forall (m :: * -> *) a. Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons ConsRep {[FieldRep (m a)]
TypeName
consFields :: [FieldRep (m a)]
consName :: TypeName
consFields :: forall v. ConsRep v -> [FieldRep v]
consName :: forall v. ConsRep v -> TypeName
..} = forall v. TypeName -> [FieldRep v] -> ConsRep v
ConsRep TypeName
consName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a. Monad m => FieldRep (m a) -> m (FieldRep a)
unpackMonadFromField [FieldRep (m a)]
consFields
unpackMonad :: Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad :: forall (m :: * -> *) a. Monad m => [ConsRep (m a)] -> m [ConsRep a]
unpackMonad = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a. Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons
isEmptyConstraint :: ConsRep a -> Bool
isEmptyConstraint :: forall a. ConsRep a -> Bool
isEmptyConstraint ConsRep {consFields :: forall v. ConsRep v -> [FieldRep v]
consFields = []} = Bool
True
isEmptyConstraint ConsRep a
_ = Bool
False
enumerate :: [FieldRep a] -> [FieldRep a]
enumerate :: forall a. [FieldRep a] -> [FieldRep a]
enumerate = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. Show a => a -> FieldRep a -> FieldRep a
setFieldName ([Int
0 ..] :: [Int])
where
setFieldName :: a -> FieldRep a -> FieldRep a
setFieldName a
i FieldRep a
field = FieldRep a
field {fieldSelector :: FieldName
fieldSelector = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ Text
"_" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall b a. (Show a, IsString b) => a -> b
show a
i)}
fieldTypeName :: FieldRep k -> TypeName
fieldTypeName :: forall k. FieldRep k -> TypeName
fieldTypeName = TypeRef -> TypeName
typeConName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FieldRep a -> TypeRef
fieldTypeRef
isUnionRef :: TypeName -> ConsRep k -> Bool
isUnionRef :: forall k. TypeName -> ConsRep k -> Bool
isUnionRef TypeName
baseName ConsRep {TypeName
consName :: TypeName
consName :: forall v. ConsRep v -> TypeName
consName, consFields :: forall v. ConsRep v -> [FieldRep v]
consFields = [FieldRep k
fieldRep]} =
TypeName
consName forall a. Eq a => a -> a -> Bool
== TypeName
baseName forall a. Semigroup a => a -> a -> a
<> forall k. FieldRep k -> TypeName
fieldTypeName FieldRep k
fieldRep
isUnionRef TypeName
_ ConsRep k
_ = Bool
False
symbolName :: KnownSymbol a => f a -> FieldName
symbolName :: forall (a :: Symbol) (f :: Symbol -> *).
KnownSymbol a =>
f a -> FieldName
symbolName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal
withKind :: Proxy a -> KindedProxy (KIND a) a
withKind :: forall a. Proxy a -> KindedProxy (KIND a) a
withKind Proxy a
_ = forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy