{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Utils
( datatypeNameProxy,
conNameProxy,
isRecordProxy,
selNameProxy,
ResRep (..),
TypeRep (..),
ConsRep (..),
TypeConstraint (..),
FieldRep (..),
isEmptyConstraint,
DataType (..),
ConRep (..),
toRep,
toValue,
isUnionRef,
fieldTypeName,
)
where
import Data.Functor (Functor (..))
import Data.Functor.Identity (Identity (..))
import Data.Morpheus.Server.Types.GQLType
( GQLType (..),
GQLTypeOptions (..),
TypeData (..),
__isObjectKind,
__typeData,
defaultTypeOptions,
)
import Data.Morpheus.Types.Internal.AST
( FieldName (..),
TypeCategory,
TypeName (..),
TypeRef (..),
convertToJSONName,
)
import Data.Morpheus.Utils.Kinded
( CategoryValue (..),
kinded,
)
import Data.Proxy (Proxy (..))
import Data.Semigroup (Semigroup (..))
import Data.Text
( pack,
)
import GHC.Exts (Constraint)
import GHC.Generics
( (:*:) (..),
(:+:) (..),
C,
Constructor,
D,
Datatype,
Generic (..),
K1 (..),
M1 (..),
Meta,
Rec0,
S,
Selector,
U1 (..),
conIsRecord,
conName,
datatypeName,
selName,
)
import Relude
( ($),
(.),
Bool (..),
Eq (..),
Int,
otherwise,
show,
undefined,
zipWith,
)
datatypeNameProxy :: forall f (d :: Meta). Datatype d => f d -> TypeName
datatypeNameProxy :: f d -> TypeName
datatypeNameProxy f d
_ = Text -> TypeName
TypeName (Text -> TypeName) -> Text -> TypeName
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 D d f Any -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName (forall a. HasCallStack => a
forall (a :: Meta). M1 D d f a
undefined :: (M1 D d f a))
conNameProxy :: forall f (c :: Meta). Constructor c => GQLTypeOptions -> f c -> TypeName
conNameProxy :: GQLTypeOptions -> f c -> TypeName
conNameProxy GQLTypeOptions
options f c
_ =
Text -> TypeName
TypeName (Text -> TypeName) -> Text -> TypeName
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ GQLTypeOptions -> String -> String
constructorTagModifier GQLTypeOptions
options (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 C c U1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall k (a :: k). M1 C c U1 a
forall a. HasCallStack => a
undefined :: M1 C c U1 a)
selNameProxy :: forall f (s :: Meta). Selector s => GQLTypeOptions -> f s -> FieldName
selNameProxy :: GQLTypeOptions -> f s -> FieldName
selNameProxy GQLTypeOptions
options f s
_ =
FieldName -> FieldName
convertToJSONName (FieldName -> FieldName) -> FieldName -> FieldName
forall a b. (a -> b) -> a -> b
$ Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ GQLTypeOptions -> String -> String
fieldLabelModifier GQLTypeOptions
options (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s f Any -> String
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
forall (a :: Meta). M1 S s f a
undefined :: M1 S s f a)
isRecordProxy :: forall f (c :: Meta). Constructor c => f c -> Bool
isRecordProxy :: f c -> Bool
isRecordProxy f c
_ = M1 C c f Any -> Bool
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
forall (a :: Meta). M1 C c f a
undefined :: (M1 C c f a))
newtype TypeConstraint (c :: * -> Constraint) (v :: *) (f :: * -> *) = TypeConstraint
{ 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 :: *) (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
-> kinded kind a -> [ConsRep value]
toRep TypeConstraint constraint value Proxy
f kinded kind a
proxy = (GQLTypeOptions, Proxy kind, TypeConstraint constraint value Proxy)
-> Proxy (Rep a) -> [ConsRep value]
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 (kinded kind a -> GQLTypeOptions -> GQLTypeOptions
forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions kinded kind a
proxy GQLTypeOptions
defaultTypeOptions, Proxy kind
forall k (t :: k). Proxy t
Proxy @kind, TypeConstraint constraint value Proxy
f) (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy @(Rep a))
toValue ::
forall proxy (kind :: TypeCategory) 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
-> proxy kind -> a -> DataType value
toValue TypeConstraint constraint value Identity
f proxy kind
proxy = (GQLTypeOptions, proxy kind,
TypeConstraint constraint value Identity)
-> Rep a Any -> DataType value
forall k (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (Proxy a -> GQLTypeOptions -> GQLTypeOptions
forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions (Proxy a
forall k (t :: k). Proxy t
Proxy @a) GQLTypeOptions
defaultTypeOptions, proxy kind
proxy, TypeConstraint constraint value Identity
f) (Rep a Any -> DataType value)
-> (a -> Rep a Any) -> a -> DataType value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
class TypeRep (c :: * -> Constraint) (v :: *) f where
typeRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Proxy) -> proxy f -> [ConsRep v]
toTypeRep :: CategoryValue kind => (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 :: (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)
_ = (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> Proxy f -> [ConsRep v]
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 (Proxy f
forall k (t :: k). Proxy t
Proxy @f)
toTypeRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> M1 D d f a -> DataType v
toTypeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun (M1 f a
src) = ((GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> DataType v
forall k (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun f a
src) {tyName :: TypeName
tyName = Proxy d -> TypeName
forall (f :: Meta -> *) (d :: Meta). Datatype d => f d -> TypeName
datatypeNameProxy (Proxy d
forall k (t :: k). Proxy t
Proxy @d)}
instance (TypeRep c v a, TypeRep c v b) => TypeRep c v (a :+: b) where
typeRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (a :+: b) -> [ConsRep v]
typeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun proxy (a :+: b)
_ = (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> Proxy a -> [ConsRep v]
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 (Proxy a
forall k (t :: k). Proxy t
Proxy @a) [ConsRep v] -> [ConsRep v] -> [ConsRep v]
forall a. Semigroup a => a -> a -> a
<> (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> Proxy b -> [ConsRep v]
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 (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
toTypeRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> (:+:) a b a -> DataType v
toTypeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
f (L1 a a
x) = ((GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> a a -> DataType v
forall k (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
f a a
x) {tyIsUnion :: Bool
tyIsUnion = Bool
True}
toTypeRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
f (R1 b a
x) = ((GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> b a -> DataType v
forall k (c :: * -> Constraint) v (f :: k -> *)
(kind :: TypeCategory) (kinProxy :: TypeCategory -> *) (a :: k).
(TypeRep c v f, CategoryValue kind) =>
(GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> f a -> DataType v
toTypeRep (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 :: (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)
_ = [GQLTypeOptions -> Proxy c -> [FieldRep v] -> ConsRep v
forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt (Proxy c
forall k (t :: k). Proxy t
Proxy @c) ((GQLTypeOptions, kinProxy kind, TypeConstraint con v Proxy)
-> Proxy f -> [FieldRep v]
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 (Proxy f
forall k (t :: k). Proxy t
Proxy @f))]
toTypeRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint con v Identity)
-> M1 C c f a -> DataType v
toTypeRep f :: (GQLTypeOptions, kinProxy kind, TypeConstraint con v Identity)
f@(GQLTypeOptions
opt, kinProxy kind
_, TypeConstraint con v Identity
_) (M1 f a
src) =
DataType :: forall v. TypeName -> Bool -> ConsRep v -> DataType v
DataType
{ tyName :: TypeName
tyName = TypeName
"",
tyIsUnion :: Bool
tyIsUnion = Bool
False,
tyCons :: ConsRep v
tyCons = GQLTypeOptions -> Proxy c -> [FieldRep v] -> ConsRep v
forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt (Proxy c
forall k (t :: k). Proxy t
Proxy @c) ((GQLTypeOptions, kinProxy kind, TypeConstraint con v Identity)
-> f a -> [FieldRep v]
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 con v Identity)
f f a
src)
}
deriveConsRep ::
Constructor (c :: Meta) =>
GQLTypeOptions ->
f c ->
[FieldRep v] ->
ConsRep v
deriveConsRep :: GQLTypeOptions -> f c -> [FieldRep v] -> ConsRep v
deriveConsRep GQLTypeOptions
opt f c
proxy [FieldRep v]
fields =
ConsRep :: forall v. TypeName -> [FieldRep v] -> ConsRep v
ConsRep
{ consName :: TypeName
consName = GQLTypeOptions -> f c -> TypeName
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
| f c -> Bool
forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool
isRecordProxy f c
proxy = [FieldRep v]
fields
| Bool
otherwise = [FieldRep v] -> [FieldRep v]
forall a. [FieldRep a] -> [FieldRep a]
enumerate [FieldRep v]
fields
class ConRep (c :: * -> Constraint) (v :: *) 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 :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy (a :*: b) -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
fun proxy (a :*: b)
_ = (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> Proxy a -> [FieldRep v]
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 (Proxy a
forall k (t :: k). Proxy t
Proxy @a) [FieldRep v] -> [FieldRep v] -> [FieldRep v]
forall a. Semigroup a => a -> a -> a
<> (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> Proxy b -> [FieldRep v]
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 (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
toFieldRep :: (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) = (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> a a -> [FieldRep v]
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 [FieldRep v] -> [FieldRep v] -> [FieldRep v]
forall a. Semigroup a => a -> a -> a
<> (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> b a -> [FieldRep v]
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 :: (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))
_ = [GQLTypeOptions -> Proxy s -> KindedProxy kind a -> v -> FieldRep v
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 s
forall k (t :: k). Proxy t
Proxy @s) (kinProxy kind -> Proxy a -> KindedProxy kind a
forall k1 k2 (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *) (a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded kinProxy kind
kind (Proxy a
forall k (t :: k). Proxy t
Proxy @a)) (Proxy a -> v
forall a. c a => Proxy a -> v
f (Proxy a -> v) -> Proxy a -> v
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)]
toFieldRep :: (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)) = [GQLTypeOptions -> Proxy s -> KindedProxy kind a -> v -> FieldRep v
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 s
forall k (t :: k). Proxy t
Proxy @s) (kinProxy kind -> Proxy a -> KindedProxy kind a
forall k1 k2 (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *) (a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded kinProxy kind
kind (Proxy a
forall k (t :: k). Proxy t
Proxy @a)) (Identity a -> v
forall a. c a => Identity a -> v
f (a -> Identity a
forall a. a -> Identity a
Identity a
src))]
deriveFieldRep ::
forall
proxy
(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
-> proxy selector -> kindedProxy kind a -> v -> FieldRep v
deriveFieldRep GQLTypeOptions
opt proxy selector
pSel kindedProxy kind a
kindedProxy v
v =
FieldRep :: forall a. FieldName -> TypeRef -> Bool -> a -> FieldRep a
FieldRep
{ fieldSelector :: FieldName
fieldSelector = GQLTypeOptions -> proxy selector -> FieldName
forall (f :: Meta -> *) (s :: Meta).
Selector s =>
GQLTypeOptions -> f s -> FieldName
selNameProxy GQLTypeOptions
opt proxy selector
pSel,
fieldTypeRef :: TypeRef
fieldTypeRef =
TypeRef :: TypeName -> [TypeWrapper] -> TypeRef
TypeRef
{ typeConName :: TypeName
typeConName = TypeName
gqlTypeName,
typeWrappers :: [TypeWrapper]
typeWrappers = [TypeWrapper]
gqlWrappers
},
fieldIsObject :: Bool
fieldIsObject = kindedProxy kind a -> Bool
forall (f :: * -> *) a. GQLType a => f a -> Bool
__isObjectKind kindedProxy kind a
kindedProxy,
fieldValue :: v
fieldValue = v
v
}
where
TypeData {TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName :: TypeName
gqlTypeName, [TypeWrapper]
gqlWrappers :: TypeData -> [TypeWrapper]
gqlWrappers :: [TypeWrapper]
gqlWrappers} = kindedProxy kind a -> TypeData
forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kindedProxy kind a
kindedProxy
instance ConRep c v U1 where
conRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
-> proxy U1 -> [FieldRep v]
conRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Proxy)
_ proxy U1
_ = []
toFieldRep :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
-> U1 a -> [FieldRep v]
toFieldRep (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
_ U1 a
_ = []
data DataType (v :: *) = DataType
{ DataType v -> TypeName
tyName :: TypeName,
DataType v -> Bool
tyIsUnion :: Bool,
DataType v -> ConsRep v
tyCons :: ConsRep v
}
data ConsRep (v :: *) = ConsRep
{ ConsRep v -> TypeName
consName :: TypeName,
ConsRep v -> [FieldRep v]
consFields :: [FieldRep v]
}
data FieldRep (a :: *) = FieldRep
{ FieldRep a -> FieldName
fieldSelector :: FieldName,
FieldRep a -> TypeRef
fieldTypeRef :: TypeRef,
FieldRep a -> Bool
fieldIsObject :: Bool,
FieldRep a -> a
fieldValue :: a
}
deriving (a -> FieldRep b -> FieldRep a
(a -> b) -> FieldRep a -> FieldRep b
(forall a b. (a -> b) -> FieldRep a -> FieldRep b)
-> (forall a b. a -> FieldRep b -> FieldRep a) -> Functor FieldRep
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
<$ :: a -> FieldRep b -> FieldRep a
$c<$ :: forall a b. a -> FieldRep b -> FieldRep a
fmap :: (a -> b) -> FieldRep a -> FieldRep b
$cfmap :: forall a b. (a -> b) -> FieldRep a -> FieldRep b
Functor)
data ResRep (a :: *)
= ResRep
{ ResRep a -> [TypeName]
unionRef :: [TypeName],
ResRep a -> [ConsRep a]
unionCons :: [ConsRep a]
}
| EnumRep {ResRep a -> [TypeName]
enumCons :: [TypeName]}
isEmptyConstraint :: ConsRep a -> Bool
isEmptyConstraint :: 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 :: [FieldRep a] -> [FieldRep a]
enumerate = (Int -> FieldRep a -> FieldRep a)
-> [Int] -> [FieldRep a] -> [FieldRep a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> FieldRep a -> FieldRep a
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 = Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (a -> String
forall b a. (Show a, IsString b) => a -> b
show a
i)}
fieldTypeName :: FieldRep k -> TypeName
fieldTypeName :: FieldRep k -> TypeName
fieldTypeName = TypeRef -> TypeName
typeConName (TypeRef -> TypeName)
-> (FieldRep k -> TypeRef) -> FieldRep k -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldRep k -> TypeRef
forall a. FieldRep a -> TypeRef
fieldTypeRef
isUnionRef :: TypeName -> ConsRep k -> Bool
isUnionRef :: 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 :: FieldRep k
fieldRep@FieldRep {fieldIsObject :: forall a. FieldRep a -> Bool
fieldIsObject = Bool
True}]} =
TypeName
consName TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeName
baseName TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> FieldRep k -> TypeName
forall k. FieldRep k -> TypeName
fieldTypeName FieldRep k
fieldRep
isUnionRef TypeName
_ ConsRep k
_ = Bool
False