{-# 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.EncodeType
  ( deriveResolver,
    EncodeTypeConstraint,
    DeriveNamedResolver (..),
  )
where

import Data.Morpheus.App.Internal.Resolving
  ( LiftOperation,
    NamedResolver (..),
    NamedResolverResult (..),
    Resolver,
    liftResolverState,
  )
import Data.Morpheus.Server.Deriving.Decode
  ( Decode,
    decode,
  )
import Data.Morpheus.Server.Deriving.Named.EncodeValue
  ( EncodeFieldKind,
    FieldConstraint,
    encodeResolverValue,
    getTypeName,
  )
import Data.Morpheus.Server.Deriving.Utils.GTraversable
import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy))
import Data.Morpheus.Server.NamedResolvers (Dependency, NamedResolverT (..), ResolveNamed (..))
import Data.Morpheus.Server.Types.GQLType
  ( GQLType,
    KIND,
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Types.GQLScalar (EncodeScalar (..))
import Data.Morpheus.Types.Internal.AST
  ( ValidValue,
  )
import Relude

deriveResolver :: Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy
deriveResolver :: forall (m :: * -> *).
Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy
deriveResolver = forall (c :: DerivingKind -> * -> Constraint) v
       (f :: DerivingKind -> * -> *).
(forall a.
 (GQLType a, c (KIND a) a) =>
 KindedProxy (KIND a) a -> v)
-> Mappable c v f
Mappable forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
DeriveNamedResolver m k a =>
f k a -> [NamedResolver m]
deriveNamedResolver

type EncodeTypeConstraint m a =
  ( GFmap
      (ScanConstraint (DeriveNamedResolver m))
      (KIND (a (NamedResolverT m)))
      (a (NamedResolverT m)),
    DeriveNamedResolver
      m
      (KIND (a (NamedResolverT m)))
      (a (NamedResolverT m)),
    GQLType (a (NamedResolverT m))
  )

class DeriveNamedResolver (m :: Type -> Type) (k :: DerivingKind) a where
  deriveNamedResolver :: f k a -> [NamedResolver m]

instance
  ( GQLType a,
    DecodeValuesConstraint o e m a,
    EncodeScalar a
  ) =>
  DeriveNamedResolver (Resolver o e m) SCALAR a
  where
  deriveNamedResolver :: forall (f :: DerivingKind -> * -> *).
f SCALAR a -> [NamedResolver (Resolver o e m)]
deriveNamedResolver f SCALAR a
_ =
    [ NamedResolver
        { resolverName :: TypeName
resolverName = forall a (f :: * -> *). GQLType a => f a -> TypeName
getTypeName Proxy a
proxy,
          resolverFun :: NamedResolverFun (Resolver o e m)
resolverFun = forall (o :: OperationType) e (m :: * -> *) a.
DecodeValuesConstraint o e m a =>
Proxy a -> [ValidValue] -> Resolver o e m [Maybe a]
decodeValues 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

type DecodeValuesConstraint o e m a =
  ( LiftOperation o,
    ResolveNamed (Resolver o e m) a,
    Monad m,
    Decode (Dependency a)
  )

decodeValues :: forall o e m a. DecodeValuesConstraint o e m a => Proxy a -> [ValidValue] -> Resolver o e m [Maybe a]
decodeValues :: forall (o :: OperationType) e (m :: * -> *) a.
DecodeValuesConstraint o e m a =>
Proxy a -> [ValidValue] -> Resolver o e m [Maybe a]
decodeValues Proxy a
_ [ValidValue]
xs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ValidValue -> Resolver o e m (Dependency a)
decodeArg [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
  where
    decodeArg :: ValidValue -> Resolver o e m (Dependency a)
    decodeArg :: ValidValue -> Resolver o e m (Dependency a)
decodeArg = forall (o :: OperationType) (m :: * -> *) a e.
(LiftOperation o, Monad m) =>
ResolverState a -> Resolver o e m a
liftResolverState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Decode a => ValidValue -> ResolverState a
decode

instance
  ( GQLType a,
    DecodeValuesConstraint o e m a,
    EncodeFieldKind (KIND a) (Resolver o e m) a,
    FieldConstraint (Resolver o e m) a
  ) =>
  DeriveNamedResolver (Resolver o e m) TYPE (a :: Type)
  where
  deriveNamedResolver :: forall (f :: DerivingKind -> * -> *).
f TYPE a -> [NamedResolver (Resolver o e m)]
deriveNamedResolver f TYPE a
_ =
    [ NamedResolver
        { resolverName :: TypeName
resolverName = forall a (f :: * -> *). GQLType a => f a -> TypeName
getTypeName Proxy a
proxy,
          resolverFun :: NamedResolverFun (Resolver o e m)
resolverFun = forall (o :: OperationType) e (m :: * -> *) a.
DecodeValuesConstraint o e m a =>
Proxy a -> [ValidValue] -> Resolver o e m [Maybe a]
decodeValues Proxy a
proxy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(MonadError GQLError m, FieldConstraint m a) =>
[Maybe a] -> m [NamedResolverResult m]
encodeResolverValue
        }
    ]
    where
      proxy :: Proxy a
proxy = forall {k} (t :: k). Proxy t
Proxy @a

instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (NamedResolverT m a) where
  deriveNamedResolver :: forall (f :: DerivingKind -> * -> *).
f CUSTOM (NamedResolverT m a) -> [NamedResolver m]
deriveNamedResolver f CUSTOM (NamedResolverT m a)
_ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
DeriveNamedResolver m k a =>
f k a -> [NamedResolver m]
deriveNamedResolver (forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy (KIND a) a)

instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (input -> a) where
  deriveNamedResolver :: forall (f :: DerivingKind -> * -> *).
f CUSTOM (input -> a) -> [NamedResolver m]
deriveNamedResolver f CUSTOM (input -> a)
_ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
DeriveNamedResolver m k a =>
f k a -> [NamedResolver m]
deriveNamedResolver (forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy (KIND a) a)

instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m WRAPPER (f a) where
  deriveNamedResolver :: forall (f :: DerivingKind -> k -> *).
f WRAPPER (f a) -> [NamedResolver m]
deriveNamedResolver f WRAPPER (f a)
_ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k)
       (f :: DerivingKind -> k -> *).
DeriveNamedResolver m k a =>
f k a -> [NamedResolver m]
deriveNamedResolver (forall {k} {k} (k :: k) (a :: k). KindedProxy k a
KindedProxy :: KindedProxy (KIND a) a)