{-# 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

--  GENERIC UNION
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}

-- | recursion for Object types, both of them : 'INPUT_OBJECT' and 'OBJECT'
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]

-- | recursion for Object types, both of them : 'UNION' and 'INPUT_UNION'
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

-- setFieldNames ::  Power Int Text -> Power { _1 :: Int, _2 :: Text }
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