{-# 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
  ( datatypeNameProxy,
    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 (..),
    __typeData,
    defaultTypeOptions,
  )
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,
    datatypeName,
    selName,
  )
import GHC.TypeLits
import Relude hiding (undefined)
import Prelude (undefined)

datatypeNameProxy :: forall f (d :: Meta). Datatype d => GQLTypeOptions -> f d -> TypeName
datatypeNameProxy :: GQLTypeOptions -> f d -> TypeName
datatypeNameProxy GQLTypeOptions
options f d
_ = Text -> TypeName
forall (t :: NAME). Text -> Name t
packName (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 -> Bool -> String -> String
typeNameModifier GQLTypeOptions
options Bool
False (String -> String) -> String -> String
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
forall (t :: NAME). Text -> Name t
packName (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
_ =
  String -> FieldName
fromHaskellName
    (String -> FieldName) -> String -> FieldName
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)

fromHaskellName :: String -> FieldName
fromHaskellName :: String -> FieldName
fromHaskellName String
hsName
  | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
hsName) Bool -> Bool -> Bool
&& (Text -> Char
T.last Text
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') = Text -> FieldName
forall (t :: NAME). Text -> Name t
packName (Text -> Text
T.init Text
name)
  | Bool
otherwise = Text -> FieldName
forall (t :: NAME). Text -> 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 :: 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

--  GENERIC UNION
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 fun :: (GQLTypeOptions, kinProxy kind, TypeConstraint c v Identity)
fun@(GQLTypeOptions
opt, kinProxy kind
_, TypeConstraint c v Identity
_) (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 = GQLTypeOptions -> Proxy d -> TypeName
forall (f :: Meta -> *) (d :: Meta).
Datatype d =>
GQLTypeOptions -> f d -> TypeName
datatypeNameProxy GQLTypeOptions
opt (Proxy d
forall k (t :: k). Proxy t
Proxy @d)}

-- | 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 :: (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]

-- | 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 :: (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 -> 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 = kindedProxy kind a -> TypeRef
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 :: kinded kind a -> TypeRef
deriveTypeRef kinded kind a
kindedProxy =
  TypeRef :: TypeName -> TypeWrapper -> TypeRef
TypeRef
    { typeConName :: TypeName
typeConName = TypeName
gqlTypeName,
      typeWrappers :: TypeWrapper
typeWrappers = TypeWrapper
gqlWrappers
    }
  where
    TypeData {TypeName
gqlTypeName :: TypeData -> TypeName
gqlTypeName :: TypeName
gqlTypeName, TypeWrapper
gqlWrappers :: TypeData -> TypeWrapper
gqlWrappers :: TypeWrapper
gqlWrappers} = kinded kind a -> TypeData
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 :: (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 -> 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)

toFieldRes :: FieldRep (m a) -> (FieldName, m a)
toFieldRes :: 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 :: 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
  FieldRep a -> m (FieldRep a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldRep :: forall a. FieldName -> TypeRef -> a -> FieldRep a
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 :: 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
..} = TypeName -> [FieldRep a] -> ConsRep a
forall v. TypeName -> [FieldRep v] -> ConsRep v
ConsRep TypeName
consName ([FieldRep a] -> ConsRep a) -> m [FieldRep a] -> m (ConsRep a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldRep (m a) -> m (FieldRep a))
-> [FieldRep (m a)] -> m [FieldRep a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldRep (m a) -> m (FieldRep a)
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 :: [ConsRep (m a)] -> m [ConsRep a]
unpackMonad = (ConsRep (m a) -> m (ConsRep a))
-> [ConsRep (m a)] -> m [ConsRep a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ConsRep (m a) -> m (ConsRep a)
forall (m :: * -> *) a. Monad m => ConsRep (m a) -> m (ConsRep a)
unpackMonadFromCons

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

-- setFieldNames ::  Power Int Text -> Power { _1 :: Int, _2 :: Text }
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
forall (t :: NAME). Text -> Name t
packName (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 k
fieldRep]} =
  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

symbolName :: KnownSymbol a => f a -> FieldName
symbolName :: f a -> FieldName
symbolName = String -> FieldName
forall a. IsString a => String -> a
fromString (String -> FieldName) -> (f a -> String) -> f a -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal

withKind :: Proxy a -> KindedProxy (KIND a) a
withKind :: Proxy a -> KindedProxy (KIND a) a
withKind Proxy a
_ = KindedProxy (KIND a) a
forall k k (k :: k) (a :: k). KindedProxy k a
KindedProxy