{-# 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 :: NamedResolvers m e query mut sub -> RootResolverValue e m
deriveNamedModel NamedResolvers m e query mut sub
NamedResolvers =
  ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
forall e (m :: * -> *).
ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
NamedResolversValue
    (ResolverMap (Resolver QUERY e m) -> RootResolverValue e m)
-> ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
forall a b. (a -> b) -> a -> b
$ [Item (ResolverMap (Resolver QUERY e m))]
-> ResolverMap (Resolver QUERY e m)
forall l. IsList l => [Item l] -> l
HM.fromList
    ([Item (ResolverMap (Resolver QUERY e m))]
 -> ResolverMap (Resolver QUERY e m))
-> [Item (ResolverMap (Resolver QUERY e m))]
-> ResolverMap (Resolver QUERY e m)
forall a b. (a -> b) -> a -> b
$ (NamedResolver (Resolver QUERY e m)
 -> (TypeName, NamedResolver (Resolver QUERY e m)))
-> [NamedResolver (Resolver QUERY e m)]
-> [(TypeName, NamedResolver (Resolver QUERY e m))]
forall a b. (a -> b) -> [a] -> [b]
map (\NamedResolver (Resolver QUERY e m)
x -> (NamedResolver (Resolver QUERY e m) -> TypeName
forall (m :: * -> *). NamedResolver m -> TypeName
resolverName NamedResolver (Resolver QUERY e m)
x, NamedResolver (Resolver QUERY e m)
x))
    ([NamedResolver (Resolver QUERY e m)]
 -> [(TypeName, NamedResolver (Resolver QUERY e m))])
-> [NamedResolver (Resolver QUERY e m)]
-> [(TypeName, NamedResolver (Resolver QUERY e m))]
forall a b. (a -> b) -> a -> b
$ [[NamedResolver (Resolver QUERY e m)]]
-> [NamedResolver (Resolver QUERY e m)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    ([[NamedResolver (Resolver QUERY e m)]]
 -> [NamedResolver (Resolver QUERY e m)])
-> [[NamedResolver (Resolver QUERY e m)]]
-> [NamedResolver (Resolver QUERY e m)]
forall a b. (a -> b) -> a -> b
$ Map TypeFingerprint [NamedResolver (Resolver QUERY e m)]
-> [[NamedResolver (Resolver QUERY e m)]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (Map TypeFingerprint [NamedResolver (Resolver QUERY e m)]
 -> [[NamedResolver (Resolver QUERY e m)]])
-> Map TypeFingerprint [NamedResolver (Resolver QUERY e m)]
-> [[NamedResolver (Resolver QUERY e m)]]
forall a b. (a -> b) -> a -> b
$ Mappable
  (DeriveNamedResolver (Resolver QUERY e m))
  [NamedResolver (Resolver QUERY e m)]
  KindedProxy
-> Proxy (query (NamedResolverT (Resolver QUERY e m)))
-> Map TypeFingerprint [NamedResolver (Resolver QUERY e m)]
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 Mappable
  (DeriveNamedResolver (Resolver QUERY e m))
  [NamedResolver (Resolver QUERY e m)]
  KindedProxy
forall (m :: * -> *).
Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy
deriveResolver (Proxy (query (NamedResolverT (Resolver QUERY e m)))
forall k (t :: k). Proxy t
Proxy @(query (NamedResolverT (Resolver QUERY e m))))