{-# 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 (..),
    Resolver,
    ResolverState,
    ResolverValue,
    liftResolverState,
  )
import Data.Morpheus.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.NamedResolvers (NamedResolverT (..), ResolveNamed (Dep, resolveNamed))
import Data.Morpheus.Server.Deriving.Decode
  ( Decode (decode),
  )
import Data.Morpheus.Server.Deriving.Named.EncodeValue
  ( Encode,
    EncodeFieldKind,
    encodeResolverValue,
    getTypeName,
  )
import Data.Morpheus.Server.Deriving.Utils
  ( TypeRep (..),
  )
import Data.Morpheus.Server.Deriving.Utils.GTraversable
import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy))
import Data.Morpheus.Server.Types.GQLType
  ( GQLType,
    KIND,
  )
import Data.Morpheus.Types.Internal.AST
  ( ValidValue,
  )
import GHC.Generics
  ( Generic (..),
  )
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 DeriveNamedResolver m SCALAR a where
  deriveNamedResolver :: forall (f :: DerivingKind -> k -> *).
f SCALAR a -> [NamedResolver m]
deriveNamedResolver f SCALAR a
_ = []

instance
  ( Monad m,
    LiftOperation o,
    Generic a,
    GQLType a,
    EncodeFieldKind (KIND a) (Resolver o e m) a,
    Decode (Dep a),
    ResolveNamed (Resolver o e m) a,
    TypeRep (Encode (Resolver o e m)) (Resolver o e m (ResolverValue (Resolver o e m))) (Rep 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 (forall {k} (t :: k). Proxy t
Proxy @a),
          resolver :: ValidValue -> Resolver o e m (NamedResolverResult (Resolver o e m))
resolver = ValidValue -> Resolver o e m a
resolve 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) =>
a -> m (NamedResolverResult m)
encodeResolverValue
        }
    ]
    where
      resolve :: ValidValue -> Resolver o e m a
      resolve :: ValidValue -> Resolver o e m a
resolve ValidValue
x = forall (o :: OperationType) (m :: * -> *) a e.
(LiftOperation o, Monad m) =>
ResolverState a -> Resolver o e m a
liftResolverState (forall a. Decode a => ValidValue -> ResolverState a
decode ValidValue
x :: ResolverState (Dep a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (ResolveNamed m a, Monad m) => Dep a -> m a
resolveNamed

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} {k1} (k2 :: k) (a :: k1). KindedProxy k2 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} {k1} (k2 :: k) (a :: k1). KindedProxy k2 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} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy (KIND a) a)