{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Named.Encode
  ( deriveNamedModel,
    EncodeNamedConstraints,
  )
where

import Data.Morpheus.App.Internal.Resolving
  ( NamedResolver (..),
    Resolver,
    RootResolverValue (..),
  )
import Data.Morpheus.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Deriving.Named.EncodeType
  ( EncodeTypeConstraint,
    deriveResolver,
  )
import Data.Morpheus.Server.Deriving.Utils.GTraversable
  ( traverseTypes,
  )
import Data.Morpheus.Types
  ( NamedResolvers (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( QUERY,
  )
import qualified GHC.Exts as HM
import Relude

type EncodeNamedConstraints e m query mut sub =
  (EncodeTypeConstraint (Resolver QUERY e m) query)

deriveNamedModel ::
  forall e m query mut sub.
  (Monad m, EncodeNamedConstraints e m query mut sub) =>
  NamedResolvers m e query mut sub ->
  RootResolverValue e m
deriveNamedModel :: forall e (m :: * -> *) (query :: (* -> *) -> *)
       (mut :: (* -> *) -> *) (sub :: (* -> *) -> *).
(Monad m, EncodeNamedConstraints e m query mut sub) =>
NamedResolvers m e query mut sub -> RootResolverValue e m
deriveNamedModel NamedResolvers m e query mut sub
NamedResolvers =
  forall e (m :: * -> *).
ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
NamedResolversValue
    forall a b. (a -> b) -> a -> b
$ forall l. IsList l => [Item l] -> l
HM.fromList
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\NamedResolver (Resolver QUERY e m)
x -> (forall (m :: * -> *). NamedResolver m -> Name 'TYPE
resolverName NamedResolver (Resolver QUERY e m)
x, NamedResolver (Resolver QUERY e m)
x))
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    forall a b. (a -> b) -> a -> b
$ forall (c :: DerivingKind -> * -> Constraint) a v.
(GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a, GQLType a) =>
Mappable c v KindedProxy -> Proxy a -> Map TypeFingerprint v
traverseTypes forall (m :: * -> *).
Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy
deriveResolver (forall {k} (t :: k). Proxy t
Proxy @(query (NamedResolverT (Resolver QUERY e m))))