{-# 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.Kinded.NamedResolver
  ( KindedNamedResolver (..),
  )
where

import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver (..),
    NamedResolver (..),
    NamedResolverResult (..),
    ResolverValue,
  )
import Data.Morpheus.Server.Deriving.Kinded.NamedResolverFun
  ( deriveNamedResolverFun,
  )
import Data.Morpheus.Server.Deriving.Utils.GRep (GRep)
import Data.Morpheus.Server.Deriving.Utils.GScan (ScanRef (..))
import Data.Morpheus.Server.Deriving.Utils.Gmap (Gmap)
import Data.Morpheus.Server.Deriving.Utils.Kinded (outputType)
import Data.Morpheus.Server.Deriving.Utils.Use (UseDeriving (..), UseGQLType (useFingerprint, useTypename), UseNamedResolver (..), UseValue (useDecodeValue))
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.NamedResolvers (Dependency, NamedResolverT (..), ResolveNamed (..))
import Data.Morpheus.Types.GQLScalar (EncodeScalar (..))
import Data.Morpheus.Types.Internal.AST
  ( ValidValue,
  )
import GHC.Generics (Rep)
import Relude

type DECODE_VALUES val m a = (ResolveNamed m a, val (Dependency a), MonadResolver m)

decodeValues :: DECODE_VALUES val m a => UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a]
decodeValues :: forall (val :: * -> Constraint) (m :: * -> *) a
       (gql :: * -> Constraint).
DECODE_VALUES val m a =>
UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a]
decodeValues UseDeriving gql val
ctx Proxy a
_ [ValidValue]
xs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadResolver m => ResolverState a -> m a
liftState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (val :: * -> Constraint).
UseValue val -> forall a. val a => ValidValue -> ResolverState a
useDecodeValue (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
dirArgs UseDeriving gql val
ctx)) [ValidValue]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(ResolveNamed m a, MonadError GQLError m) =>
[Dependency a] -> m [Maybe a]
resolveBatched

class KindedNamedResolver namedRes resFun gql val (m :: Type -> Type) (k :: DerivingKind) a where
  kindedNamedResolver :: UseNamedResolver namedRes resFun gql val -> f k a -> [NamedResolver m]
  kindedNamedRefs :: UseNamedResolver namedRes resFun gql val -> f k a -> [ScanRef (namedRes m)]

instance
  ( DECODE_VALUES val m a,
    gql a,
    namedRes m a,
    EncodeScalar a
  ) =>
  KindedNamedResolver namedRes resFun gql val m SCALAR a
  where
  kindedNamedResolver :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f SCALAR a -> [NamedResolver m]
kindedNamedResolver UseNamedResolver namedRes resFun gql val
ctx f SCALAR a
_ =
    [ NamedResolver
        { resolverName :: TypeName
resolverName = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL forall a b. (a -> b) -> a -> b
$ forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType Proxy a
proxy),
          resolverFun :: NamedResolverFun m
resolverFun = forall (val :: * -> Constraint) (m :: * -> *) a
       (gql :: * -> Constraint).
DECODE_VALUES val m a =>
UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a]
decodeValues (forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) Proxy a
proxy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *). NamedResolverResult m
NamedNullResolver (forall (m :: * -> *). ScalarValue -> NamedResolverResult m
NamedScalarResolver forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncodeScalar a => a -> ScalarValue
encodeScalar))
        }
    ]
    where
      proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy @a
  kindedNamedRefs :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f SCALAR a -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver namedRes resFun gql val
ctx f SCALAR a
_ = [forall (f :: * -> *) a (c :: * -> Constraint).
c a =>
TypeFingerprint -> f a -> ScanRef c
ScanType TypeFingerprint
fp Proxy a
proxy]
    where
      fp :: TypeFingerprint
fp = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> TypeFingerprint
useFingerprint (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL forall a b. (a -> b) -> a -> b
$ forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType Proxy a
proxy)
      proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy @a

instance
  ( DECODE_VALUES val m a,
    gql a,
    namedRes m a,
    Generic a,
    gql [Maybe a],
    GRep gql (resFun m) (m (ResolverValue m)) (Rep a),
    Gmap (namedRes m) (Rep a)
  ) =>
  KindedNamedResolver namedRes resFun gql val m TYPE (a :: Type)
  where
  kindedNamedResolver :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f TYPE a -> [NamedResolver m]
kindedNamedResolver UseNamedResolver namedRes resFun gql val
ctx f TYPE a
_ =
    [ NamedResolver
        { resolverName :: TypeName
resolverName = forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL forall a b. (a -> b) -> a -> b
$ forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType Proxy a
proxy),
          resolverFun :: NamedResolverFun m
resolverFun = forall (val :: * -> Constraint) (m :: * -> *) a
       (gql :: * -> Constraint).
DECODE_VALUES val m a =>
UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a]
decodeValues (forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) Proxy a
proxy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (gql :: * -> Constraint) (m :: * -> *)
       (res :: (* -> *) -> * -> Constraint)
       (namedRes :: (* -> *) -> * -> Constraint) (val :: * -> Constraint).
(Generic a, gql [Maybe a], gql a, MonadError GQLError m,
 GRep gql (res m) (m (ResolverValue m)) (Rep a)) =>
UseNamedResolver namedRes res gql val
-> [Maybe a] -> m [NamedResolverResult m]
deriveNamedResolverFun UseNamedResolver namedRes resFun gql val
ctx
        }
    ]
    where
      proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy @a

  kindedNamedRefs :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f TYPE a -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver namedRes resFun gql val
ctx f TYPE a
_ = [forall (f :: * -> *) a (c :: * -> Constraint).
(Gmap c (Rep a), c a) =>
TypeFingerprint -> f a -> ScanRef c
ScanObject (forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a.
   gql a =>
   CatType c a -> TypeFingerprint
useFingerprint (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL forall a b. (a -> b) -> a -> b
$ forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val -> UseDeriving gql val
namedDrv UseNamedResolver namedRes resFun gql val
ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a
outputType Proxy a
proxy)) Proxy a
proxy]
    where
      proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy @a

instance namedRes m a => KindedNamedResolver namedRes resFun gql val m CUSTOM (NamedResolverT m a) where
  kindedNamedResolver :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f CUSTOM (NamedResolverT m a) -> [NamedResolver m]
kindedNamedResolver UseNamedResolver namedRes resFun gql val
ctx f CUSTOM (NamedResolverT m a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [NamedResolver m]
useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)
  kindedNamedRefs :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f CUSTOM (NamedResolverT m a) -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver namedRes resFun gql val
ctx f CUSTOM (NamedResolverT m a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [ScanRef (named m)]
useDeriveNamedRefs UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)

instance namedRes m a => KindedNamedResolver namedRes resFun gql val m CUSTOM (input -> a) where
  kindedNamedResolver :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f CUSTOM (input -> a) -> [NamedResolver m]
kindedNamedResolver UseNamedResolver namedRes resFun gql val
ctx f CUSTOM (input -> a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [NamedResolver m]
useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)
  kindedNamedRefs :: forall (f :: DerivingKind -> * -> *).
UseNamedResolver namedRes resFun gql val
-> f CUSTOM (input -> a) -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver namedRes resFun gql val
ctx f CUSTOM (input -> a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [ScanRef (named m)]
useDeriveNamedRefs UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)

instance namedRes m a => KindedNamedResolver namedRes resFun gql val m WRAPPER (f a) where
  kindedNamedResolver :: forall (f :: DerivingKind -> k -> *).
UseNamedResolver namedRes resFun gql val
-> f WRAPPER (f a) -> [NamedResolver m]
kindedNamedResolver UseNamedResolver namedRes resFun gql val
ctx f WRAPPER (f a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [NamedResolver m]
useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)
  kindedNamedRefs :: forall (f :: DerivingKind -> k -> *).
UseNamedResolver namedRes resFun gql val
-> f WRAPPER (f a) -> [ScanRef (namedRes m)]
kindedNamedRefs UseNamedResolver namedRes resFun gql val
ctx f WRAPPER (f a)
_ = forall (named :: (* -> *) -> * -> Constraint)
       (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint)
       (val :: * -> Constraint).
UseNamedResolver named fun gql val
-> forall (f :: * -> *) a (m :: * -> *).
   named m a =>
   f a -> [ScanRef (named m)]
useDeriveNamedRefs UseNamedResolver namedRes resFun gql val
ctx (forall {k} (t :: k). Proxy t
Proxy @a)