{-# 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.Generic.GRep
  ( GRep (..),
    GRepFun (..),
    GRepCons (..),
    GRepField (..),
    GRepValue (..),
    GRepType (..),
    deriveValue,
    deriveType,
  )
where

import Data.List (partition)
import Data.Morpheus.Generic.Proxy
  ( conNameP,
    isRecordP,
    selNameP,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    TypeName,
    TypeRef (..),
    TypeWrapper,
    packName,
  )
import Data.Text (pack)
import GHC.Generics
  ( C,
    Constructor,
    D,
    Datatype,
    Generic (..),
    K1 (..),
    M1 (..),
    Meta,
    Rec0,
    S,
    Selector,
    U1 (..),
    (:*:) (..),
    (:+:) (..),
  )
import Relude hiding (undefined)

data GRepFun gql fun f result = GRepFun
  { forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result -> forall (a :: k). fun a => f a -> result
grepFun :: forall a. (fun a) => f a -> result,
    forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepTypename :: forall proxy a. (gql a) => proxy a -> TypeName,
    forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k).
   gql a =>
   proxy a -> TypeWrapper
grepWrappers :: forall proxy a. (gql a) => proxy a -> TypeWrapper
  }

deriveValue ::
  (Generic a, GRep gql constraint value (Rep a), gql a) =>
  GRepFun gql constraint Identity value ->
  a ->
  GRepValue value
deriveValue :: forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
GRepFun gql constraint Identity value -> a -> GRepValue value
deriveValue GRepFun gql constraint Identity value
options a
value
  | GRepCons value -> Bool
forall a. GRepCons a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null GRepCons value
cons = TypeName -> TypeName -> GRepValue value
forall v. TypeName -> TypeName -> GRepValue v
GRepValueEnum TypeName
typename (GRepCons value -> TypeName
forall a. GRepCons a -> TypeName
consName GRepCons value
cons)
  | Bool
isUnion = case (TypeName -> GRepCons value -> Bool
forall k. TypeName -> GRepCons k -> Bool
isUnionRef TypeName
typename GRepCons value
cons, GRepCons value -> [GRepField value]
forall a. GRepCons a -> [GRepField a]
consFields GRepCons value
cons) of
      (Bool
True, [GRepField {value
FieldName
TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldValue :: value
fieldSelector :: forall a. GRepField a -> FieldName
fieldTypeRef :: forall a. GRepField a -> TypeRef
fieldValue :: forall a. GRepField a -> a
..}]) -> TypeName -> value -> GRepValue value
forall v. TypeName -> v -> GRepValue v
GRepValueUnionRef (TypeRef -> TypeName
typeConName TypeRef
fieldTypeRef) value
fieldValue
      (Bool, [GRepField value])
_ -> TypeName -> TypeName -> [GRepField value] -> GRepValue value
forall v. TypeName -> TypeName -> [GRepField v] -> GRepValue v
GRepValueUnion TypeName
typename (GRepCons value -> TypeName
forall a. GRepCons a -> TypeName
consName GRepCons value
cons) (GRepCons value -> [GRepField value]
forall a. GRepCons a -> [GRepField a]
consFields GRepCons value
cons)
  | Bool
otherwise = TypeName -> [GRepField value] -> GRepValue value
forall v. TypeName -> [GRepField v] -> GRepValue v
GRepValueObject TypeName
typename (GRepCons value -> [GRepField value]
forall a. GRepCons a -> [GRepField a]
consFields GRepCons value
cons)
  where
    (Bool
isUnion, GRepCons value
cons) = GRepFun gql constraint Identity value
-> Rep a Any -> (Bool, GRepCons value)
forall a.
GRepFun gql constraint Identity value
-> Rep a a -> (Bool, GRepCons value)
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
GRep gql c v f =>
GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql constraint Identity value
options (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
value)
    typename :: TypeName
typename = GRepFun gql constraint Identity value
-> forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepTypename GRepFun gql constraint Identity value
options (a -> Identity a
forall a. a -> Identity a
Identity a
value)

toRep :: f a -> Proxy (Rep a)
toRep :: forall (f :: * -> *) a. f a -> Proxy (Rep a)
toRep f a
_ = Proxy (Rep a)
forall {k} (t :: k). Proxy t
Proxy

deriveType ::
  forall kind gql c v kinded m a.
  (GRep gql c (m v) (Rep a), Monad m, gql a) =>
  GRepFun gql c Proxy (m v) ->
  kinded kind a ->
  m (GRepType v)
deriveType :: forall {k} (kind :: k) (gql :: * -> Constraint)
       (c :: * -> Constraint) v (kinded :: k -> * -> *) (m :: * -> *) a.
(GRep gql c (m v) (Rep a), Monad m, gql a) =>
GRepFun gql c Proxy (m v) -> kinded kind a -> m (GRepType v)
deriveType GRepFun gql c Proxy (m v)
ctx kinded kind a
x = [GRepCons v] -> GRepType v
forall {v}. [GRepCons v] -> GRepType v
toType ([GRepCons v] -> GRepType v) -> m [GRepCons v] -> m (GRepType v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GRepCons (m v)] -> m [GRepCons v]
forall (m :: * -> *) a.
Monad m =>
[GRepCons (m a)] -> m [GRepCons a]
unpackMonad (GRepFun gql c Proxy (m v) -> Proxy (Rep a) -> [GRepCons (m v)]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
GRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepCons v]
forall (proxy :: (* -> *) -> *).
GRepFun gql c Proxy (m v) -> proxy (Rep a) -> [GRepCons (m v)]
deriveTypeDefinition GRepFun gql c Proxy (m v)
ctx (kinded kind a -> Proxy (Rep a)
forall (f :: * -> *) a. f a -> Proxy (Rep a)
toRep kinded kind a
x))
  where
    toType :: [GRepCons v] -> GRepType v
toType [GRepCons v]
cons | (GRepCons v -> Bool) -> [GRepCons v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GRepCons v -> Bool
forall a. GRepCons a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GRepCons v]
cons = [TypeName] -> GRepType v
forall v. [TypeName] -> GRepType v
GRepTypeEnum (GRepCons v -> TypeName
forall a. GRepCons a -> TypeName
consName (GRepCons v -> TypeName) -> [GRepCons v] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GRepCons v]
cons)
    toType [GRepCons {[GRepField v]
consFields :: forall a. GRepCons a -> [GRepField a]
consFields :: [GRepField v]
consFields}] = [GRepField v] -> GRepType v
forall v. [GRepField v] -> GRepType v
GRepTypeObject [GRepField v]
consFields
    toType [GRepCons v]
cons = [(TypeName, v)] -> [GRepCons v] -> GRepType v
forall v. [(TypeName, v)] -> [GRepCons v] -> GRepType v
GRepTypeUnion [(TypeName, v)]
unionRef [GRepCons v]
unionCons
      where
        unionRef :: [(TypeName, v)]
unionRef = GRepField v -> (TypeName, v)
forall {b}. GRepField b -> (TypeName, b)
toVer (GRepField v -> (TypeName, v)) -> [GRepField v] -> [(TypeName, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GRepCons v -> [GRepField v]) -> [GRepCons v] -> [GRepField v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GRepCons v -> [GRepField v]
forall a. GRepCons a -> [GRepField a]
consFields [GRepCons v]
unionRefRep
          where
            toVer :: GRepField b -> (TypeName, b)
toVer GRepField {b
FieldName
TypeRef
fieldSelector :: forall a. GRepField a -> FieldName
fieldTypeRef :: forall a. GRepField a -> TypeRef
fieldValue :: forall a. GRepField a -> a
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldValue :: b
..} = (TypeRef -> TypeName
typeConName TypeRef
fieldTypeRef, b
fieldValue)
        --
        ([GRepCons v]
unionRefRep, [GRepCons v]
unionCons) = (GRepCons v -> Bool)
-> [GRepCons v] -> ([GRepCons v], [GRepCons v])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (TypeName -> GRepCons v -> Bool
forall k. TypeName -> GRepCons k -> Bool
isUnionRef TypeName
typename) [GRepCons v]
cons
        typename :: TypeName
typename = GRepFun gql c Proxy (m v)
-> forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepTypename GRepFun gql c Proxy (m v)
ctx kinded kind a
x

--  GENERIC UNION
class GRep (gql :: Type -> Constraint) (c :: Type -> Constraint) (v :: Type) f where
  deriveTypeValue :: GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
  deriveTypeDefinition :: GRepFun gql c Proxy v -> proxy f -> [GRepCons v]

instance (Datatype d, GRep gql c v f) => GRep gql c v (M1 D d f) where
  deriveTypeValue :: forall (a :: k).
GRepFun gql c Identity v -> M1 D d f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql c Identity v
options (M1 f a
src) = GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
forall (a :: k).
GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
GRep gql c v f =>
GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql c Identity v
options f a
src
  deriveTypeDefinition :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (M1 D d f) -> [GRepCons v]
deriveTypeDefinition GRepFun gql c Proxy v
options proxy (M1 D d f)
_ = GRepFun gql c Proxy v -> Proxy f -> [GRepCons v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
GRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepCons v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy f -> [GRepCons v]
deriveTypeDefinition GRepFun gql c Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f)

-- | recursion for Object types, both of them : 'INPUT_OBJECT' and 'OBJECT'
instance (GRep gql c v a, GRep gql c v b) => GRep gql c v (a :+: b) where
  deriveTypeValue :: forall (a :: k).
GRepFun gql c Identity v -> (:+:) a b a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql c Identity v
f (L1 a a
x) = (Bool
True, (Bool, GRepCons v) -> GRepCons v
forall a b. (a, b) -> b
snd (GRepFun gql c Identity v -> a a -> (Bool, GRepCons v)
forall (a :: k).
GRepFun gql c Identity v -> a a -> (Bool, GRepCons v)
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
GRep gql c v f =>
GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql c Identity v
f a a
x))
  deriveTypeValue GRepFun gql c Identity v
f (R1 b a
x) = (Bool
True, (Bool, GRepCons v) -> GRepCons v
forall a b. (a, b) -> b
snd (GRepFun gql c Identity v -> b a -> (Bool, GRepCons v)
forall (a :: k).
GRepFun gql c Identity v -> b a -> (Bool, GRepCons v)
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
GRep gql c v f =>
GRepFun gql c Identity v -> f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql c Identity v
f b a
x))
  deriveTypeDefinition :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (a :+: b) -> [GRepCons v]
deriveTypeDefinition GRepFun gql c Proxy v
options proxy (a :+: b)
_ = GRepFun gql c Proxy v -> Proxy a -> [GRepCons v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
GRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepCons v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy a -> [GRepCons v]
deriveTypeDefinition GRepFun gql c Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a) [GRepCons v] -> [GRepCons v] -> [GRepCons v]
forall a. Semigroup a => a -> a -> a
<> GRepFun gql c Proxy v -> Proxy b -> [GRepCons v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
GRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepCons v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy b -> [GRepCons v]
deriveTypeDefinition GRepFun gql c Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @b)

instance (DeriveFieldRep gql con v f, Constructor c) => GRep gql con v (M1 C c f) where
  deriveTypeValue :: forall (a :: k).
GRepFun gql con Identity v -> M1 C c f a -> (Bool, GRepCons v)
deriveTypeValue GRepFun gql con Identity v
options (M1 f a
src) = (Bool
False, Proxy c -> [GRepField v] -> GRepCons v
forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
f c -> [GRepField v] -> GRepCons v
deriveConsRep (forall {k} (t :: k). Proxy t
forall (t :: Meta). Proxy t
Proxy @c) (GRepFun gql con Identity v -> f a -> [GRepField v]
forall (a :: k). GRepFun gql con Identity v -> f a -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
DeriveFieldRep gql c v f =>
GRepFun gql c Identity v -> f a -> [GRepField v]
toFieldRep GRepFun gql con Identity v
options f a
src))
  deriveTypeDefinition :: forall (proxy :: (k -> *) -> *).
GRepFun gql con Proxy v -> proxy (M1 C c f) -> [GRepCons v]
deriveTypeDefinition GRepFun gql con Proxy v
options proxy (M1 C c f)
_ = [Proxy c -> [GRepField v] -> GRepCons v
forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
f c -> [GRepField v] -> GRepCons v
deriveConsRep (forall {k} (t :: k). Proxy t
forall (t :: Meta). Proxy t
Proxy @c) (GRepFun gql con Proxy v -> Proxy f -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
DeriveFieldRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepField v]
forall (proxy :: (k -> *) -> *).
GRepFun gql con Proxy v -> proxy f -> [GRepField v]
conRep GRepFun gql con Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @f))]

deriveConsRep ::
  (Constructor (c :: Meta)) =>
  f c ->
  [GRepField v] ->
  GRepCons v
deriveConsRep :: forall (c :: Meta) (f :: Meta -> *) v.
Constructor c =>
f c -> [GRepField v] -> GRepCons v
deriveConsRep f c
proxy [GRepField v]
fields = GRepCons {[GRepField v]
TypeName
consName :: TypeName
consFields :: [GRepField v]
consName :: TypeName
consFields :: [GRepField v]
..}
  where
    consName :: TypeName
consName = f c -> TypeName
forall (f :: Meta -> *) t (c :: Meta).
(Constructor c, IsString t) =>
f c -> t
conNameP f c
proxy
    consFields :: [GRepField v]
consFields
      | f c -> Bool
forall (f :: Meta -> *) (c :: Meta). Constructor c => f c -> Bool
isRecordP f c
proxy = [GRepField v]
fields
      | Bool
otherwise = [GRepField v] -> [GRepField v]
forall a. [GRepField a] -> [GRepField a]
enumerate [GRepField v]
fields

class DeriveFieldRep (gql :: Type -> Constraint) (c :: Type -> Constraint) (v :: Type) f where
  toFieldRep :: GRepFun gql c Identity v -> f a -> [GRepField v]
  conRep :: GRepFun gql c Proxy v -> proxy f -> [GRepField v]
  scanRec :: GRepFun gql c Proxy v -> proxy f -> [v]

instance (DeriveFieldRep gql c v a, DeriveFieldRep gql c v b) => DeriveFieldRep gql c v (a :*: b) where
  toFieldRep :: forall (a :: k).
GRepFun gql c Identity v -> (:*:) a b a -> [GRepField v]
toFieldRep GRepFun gql c Identity v
options (a a
a :*: b a
b) = GRepFun gql c Identity v -> a a -> [GRepField v]
forall (a :: k). GRepFun gql c Identity v -> a a -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
DeriveFieldRep gql c v f =>
GRepFun gql c Identity v -> f a -> [GRepField v]
toFieldRep GRepFun gql c Identity v
options a a
a [GRepField v] -> [GRepField v] -> [GRepField v]
forall a. Semigroup a => a -> a -> a
<> GRepFun gql c Identity v -> b a -> [GRepField v]
forall (a :: k). GRepFun gql c Identity v -> b a -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (a :: k).
DeriveFieldRep gql c v f =>
GRepFun gql c Identity v -> f a -> [GRepField v]
toFieldRep GRepFun gql c Identity v
options b a
b
  conRep :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (a :*: b) -> [GRepField v]
conRep GRepFun gql c Proxy v
options proxy (a :*: b)
_ = GRepFun gql c Proxy v -> Proxy a -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
DeriveFieldRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepField v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy a -> [GRepField v]
conRep GRepFun gql c Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a) [GRepField v] -> [GRepField v] -> [GRepField v]
forall a. Semigroup a => a -> a -> a
<> GRepFun gql c Proxy v -> Proxy b -> [GRepField v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
DeriveFieldRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [GRepField v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy b -> [GRepField v]
conRep GRepFun gql c Proxy v
options (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @b)
  scanRec :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (a :*: b) -> [v]
scanRec GRepFun gql c Proxy v
ctx proxy (a :*: b)
_ = GRepFun gql c Proxy v -> Proxy a -> [v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
DeriveFieldRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy a -> [v]
scanRec GRepFun gql c Proxy v
ctx (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @a) [v] -> [v] -> [v]
forall a. Semigroup a => a -> a -> a
<> GRepFun gql c Proxy v -> Proxy b -> [v]
forall {k} (gql :: * -> Constraint) (c :: * -> Constraint) v
       (f :: k -> *) (proxy :: (k -> *) -> *).
DeriveFieldRep gql c v f =>
GRepFun gql c Proxy v -> proxy f -> [v]
forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy b -> [v]
scanRec GRepFun gql c Proxy v
ctx (forall {k} (t :: k). Proxy t
forall (t :: k -> *). Proxy t
Proxy @b)

instance (Selector s, gql a, c a) => DeriveFieldRep gql c v (M1 S s (Rec0 a)) where
  toFieldRep :: forall (a :: k).
GRepFun gql c Identity v -> M1 S s (Rec0 a) a -> [GRepField v]
toFieldRep GRepFun {forall a. c a => Identity a -> v
forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepFun :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result -> forall (a :: k). fun a => f a -> result
grepTypename :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepWrappers :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k).
   gql a =>
   proxy a -> TypeWrapper
grepFun :: forall a. c a => Identity a -> v
grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
..} (M1 (K1 a
src)) =
    [ GRepField
        { fieldSelector :: FieldName
fieldSelector = Proxy s -> FieldName
forall (f :: Meta -> *) t (s :: Meta).
(Selector s, IsString t) =>
f s -> t
selNameP (forall {k} (t :: k). Proxy t
forall (t :: Meta). Proxy t
Proxy @s),
          fieldTypeRef :: TypeRef
fieldTypeRef = TypeName -> TypeWrapper -> TypeRef
TypeRef (Proxy a -> TypeName
forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Proxy a -> TypeWrapper
forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)),
          fieldValue :: v
fieldValue = Identity a -> v
forall a. c a => Identity a -> v
grepFun (a -> Identity a
forall a. a -> Identity a
Identity a
src)
        }
    ]

  conRep :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (M1 S s (Rec0 a)) -> [GRepField v]
conRep GRepFun {forall a. c a => Proxy a -> v
forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepFun :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result -> forall (a :: k). fun a => f a -> result
grepTypename :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepWrappers :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k).
   gql a =>
   proxy a -> TypeWrapper
grepFun :: forall a. c a => Proxy a -> v
grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
..} proxy (M1 S s (Rec0 a))
_ =
    [ GRepField
        { fieldSelector :: FieldName
fieldSelector = Proxy s -> FieldName
forall (f :: Meta -> *) t (s :: Meta).
(Selector s, IsString t) =>
f s -> t
selNameP (forall {k} (t :: k). Proxy t
forall (t :: Meta). Proxy t
Proxy @s),
          fieldTypeRef :: TypeRef
fieldTypeRef = TypeName -> TypeWrapper -> TypeRef
TypeRef (Proxy a -> TypeName
forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Proxy a -> TypeWrapper
forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)),
          fieldValue :: v
fieldValue = Proxy a -> v
forall a. c a => Proxy a -> v
grepFun (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
        }
    ]
  scanRec :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy (M1 S s (Rec0 a)) -> [v]
scanRec GRepFun {forall a. c a => Proxy a -> v
forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepFun :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result -> forall (a :: k). fun a => f a -> result
grepTypename :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k). gql a => proxy a -> TypeName
grepWrappers :: forall {k} {k} (gql :: k -> Constraint) (fun :: k -> Constraint)
       (f :: k -> *) result.
GRepFun gql fun f result
-> forall (proxy :: k -> *) (a :: k).
   gql a =>
   proxy a -> TypeWrapper
grepFun :: forall a. c a => Proxy a -> v
grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
..} proxy (M1 S s (Rec0 a))
_ = [Proxy a -> v
forall a. c a => Proxy a -> v
grepFun (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)]

instance DeriveFieldRep gql c v U1 where
  toFieldRep :: forall (a :: k). GRepFun gql c Identity v -> U1 a -> [GRepField v]
toFieldRep GRepFun gql c Identity v
_ U1 a
_ = []
  conRep :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy U1 -> [GRepField v]
conRep GRepFun gql c Proxy v
_ proxy U1
_ = []
  scanRec :: forall (proxy :: (k -> *) -> *).
GRepFun gql c Proxy v -> proxy U1 -> [v]
scanRec GRepFun gql c Proxy v
_ proxy U1
_ = []

data GRepType v
  = GRepTypeEnum [TypeName]
  | GRepTypeObject [GRepField v]
  | GRepTypeUnion
      { forall v. GRepType v -> [(TypeName, v)]
variantRefs :: [(TypeName, v)],
        forall v. GRepType v -> [GRepCons v]
inlineVariants :: [GRepCons v]
      }

instance Foldable GRepType where
  foldr :: forall a b. (a -> b -> b) -> b -> GRepType a -> b
foldr a -> b -> b
_ b
res GRepTypeEnum {} = b
res
  foldr a -> b -> b
f b
res (GRepTypeObject [GRepField a]
fields) = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
res ((GRepField a -> a) -> [GRepField a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map GRepField a -> a
forall a. GRepField a -> a
fieldValue [GRepField a]
fields)
  foldr a -> b -> b
f b
res GRepTypeUnion {[GRepCons a]
inlineVariants :: forall v. GRepType v -> [GRepCons v]
inlineVariants :: [GRepCons a]
inlineVariants, [(TypeName, a)]
variantRefs :: forall v. GRepType v -> [(TypeName, v)]
variantRefs :: [(TypeName, a)]
variantRefs} = (a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
res ((GRepCons a -> [a]) -> [GRepCons a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GRepCons a -> [a]
forall a. GRepCons a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [GRepCons a]
inlineVariants [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> ((TypeName, a) -> a) -> [(TypeName, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (TypeName, a) -> a
forall a b. (a, b) -> b
snd [(TypeName, a)]
variantRefs)

data GRepValue v
  = GRepValueUnionRef
      { forall v. GRepValue v -> TypeName
unionRefTypeName :: TypeName,
        forall v. GRepValue v -> v
unionRefValue :: v
      }
  | GRepValueUnion
      { forall v. GRepValue v -> TypeName
unionTypeName :: TypeName,
        forall v. GRepValue v -> TypeName
unionVariantName :: TypeName,
        forall v. GRepValue v -> [GRepField v]
unionFields :: [GRepField v]
      }
  | GRepValueObject
      { forall v. GRepValue v -> TypeName
objectTypeName :: TypeName,
        forall v. GRepValue v -> [GRepField v]
objectFields :: [GRepField v]
      }
  | GRepValueEnum
      { forall v. GRepValue v -> TypeName
enumTypeName :: TypeName,
        forall v. GRepValue v -> TypeName
enumVariantName :: TypeName
      }
  deriving ((forall a b. (a -> b) -> GRepValue a -> GRepValue b)
-> (forall a b. a -> GRepValue b -> GRepValue a)
-> Functor GRepValue
forall a b. a -> GRepValue b -> GRepValue a
forall a b. (a -> b) -> GRepValue a -> GRepValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GRepValue a -> GRepValue b
fmap :: forall a b. (a -> b) -> GRepValue a -> GRepValue b
$c<$ :: forall a b. a -> GRepValue b -> GRepValue a
<$ :: forall a b. a -> GRepValue b -> GRepValue a
Functor)

data GRepCons (a :: Type) = GRepCons
  { forall a. GRepCons a -> TypeName
consName :: TypeName,
    forall a. GRepCons a -> [GRepField a]
consFields :: [GRepField a]
  }
  deriving ((forall a b. (a -> b) -> GRepCons a -> GRepCons b)
-> (forall a b. a -> GRepCons b -> GRepCons a) -> Functor GRepCons
forall a b. a -> GRepCons b -> GRepCons a
forall a b. (a -> b) -> GRepCons a -> GRepCons b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GRepCons a -> GRepCons b
fmap :: forall a b. (a -> b) -> GRepCons a -> GRepCons b
$c<$ :: forall a b. a -> GRepCons b -> GRepCons a
<$ :: forall a b. a -> GRepCons b -> GRepCons a
Functor)

instance Foldable GRepCons where
  foldMap :: forall m a. Monoid m => (a -> m) -> GRepCons a -> m
foldMap a -> m
f GRepCons {[GRepField a]
TypeName
consName :: forall a. GRepCons a -> TypeName
consFields :: forall a. GRepCons a -> [GRepField a]
consName :: TypeName
consFields :: [GRepField a]
..} = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ((GRepField a -> a) -> [GRepField a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map GRepField a -> a
forall a. GRepField a -> a
fieldValue [GRepField a]
consFields)

data GRepField (a :: Type) = GRepField
  { forall a. GRepField a -> FieldName
fieldSelector :: FieldName,
    forall a. GRepField a -> TypeRef
fieldTypeRef :: TypeRef,
    forall a. GRepField a -> a
fieldValue :: a
  }
  deriving ((forall a b. (a -> b) -> GRepField a -> GRepField b)
-> (forall a b. a -> GRepField b -> GRepField a)
-> Functor GRepField
forall a b. a -> GRepField b -> GRepField a
forall a b. (a -> b) -> GRepField a -> GRepField b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GRepField a -> GRepField b
fmap :: forall a b. (a -> b) -> GRepField a -> GRepField b
$c<$ :: forall a b. a -> GRepField b -> GRepField a
<$ :: forall a b. a -> GRepField b -> GRepField a
Functor)

-- setFieldNames ::  Power Int Text -> Power { _1 :: Int, _2 :: Text }
enumerate :: [GRepField a] -> [GRepField a]
enumerate :: forall a. [GRepField a] -> [GRepField a]
enumerate = (Int -> GRepField a -> GRepField a)
-> [Int] -> [GRepField a] -> [GRepField a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> GRepField a -> GRepField a
forall {a} {a}. Show a => a -> GRepField a -> GRepField a
setFieldName ([Int
0 ..] :: [Int])
  where
    setFieldName :: a -> GRepField a -> GRepField a
setFieldName a
i GRepField a
field = GRepField a
field {fieldSelector = packName $ "_" <> pack (show i)}

isUnionRef :: TypeName -> GRepCons k -> Bool
isUnionRef :: forall k. TypeName -> GRepCons k -> Bool
isUnionRef TypeName
baseName GRepCons {TypeName
consName :: forall a. GRepCons a -> TypeName
consName :: TypeName
consName, consFields :: forall a. GRepCons a -> [GRepField a]
consFields = [GRepField 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
<> TypeRef -> TypeName
typeConName (GRepField k -> TypeRef
forall a. GRepField a -> TypeRef
fieldTypeRef GRepField k
fieldRep)
isUnionRef TypeName
_ GRepCons k
_ = Bool
False

unpackMonad :: (Monad m) => [GRepCons (m a)] -> m [GRepCons a]
unpackMonad :: forall (m :: * -> *) a.
Monad m =>
[GRepCons (m a)] -> m [GRepCons a]
unpackMonad = (GRepCons (m a) -> m (GRepCons a))
-> [GRepCons (m a)] -> m [GRepCons a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GRepCons (m a) -> m (GRepCons a)
forall (m :: * -> *) a. Monad m => GRepCons (m a) -> m (GRepCons a)
unpackMonadFromCons

unpackMonadFromField :: (Monad m) => GRepField (m a) -> m (GRepField a)
unpackMonadFromField :: forall (m :: * -> *) a.
Monad m =>
GRepField (m a) -> m (GRepField a)
unpackMonadFromField GRepField {m a
FieldName
TypeRef
fieldSelector :: forall a. GRepField a -> FieldName
fieldTypeRef :: forall a. GRepField a -> TypeRef
fieldValue :: forall a. GRepField a -> a
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldValue :: m a
..} = do
  a
cont <- m a
fieldValue
  GRepField a -> m (GRepField a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GRepField {fieldValue :: a
fieldValue = a
cont, FieldName
TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
..})

unpackMonadFromCons :: (Monad m) => GRepCons (m a) -> m (GRepCons a)
unpackMonadFromCons :: forall (m :: * -> *) a. Monad m => GRepCons (m a) -> m (GRepCons a)
unpackMonadFromCons GRepCons {[GRepField (m a)]
TypeName
consName :: forall a. GRepCons a -> TypeName
consFields :: forall a. GRepCons a -> [GRepField a]
consName :: TypeName
consFields :: [GRepField (m a)]
..} = TypeName -> [GRepField a] -> GRepCons a
forall a. TypeName -> [GRepField a] -> GRepCons a
GRepCons TypeName
consName ([GRepField a] -> GRepCons a) -> m [GRepField a] -> m (GRepCons a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GRepField (m a) -> m (GRepField a))
-> [GRepField (m a)] -> m [GRepField a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse GRepField (m a) -> m (GRepField a)
forall (m :: * -> *) a.
Monad m =>
GRepField (m a) -> m (GRepField a)
unpackMonadFromField [GRepField (m a)]
consFields