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

module Data.Morpheus.Server.Deriving.Kinded.Resolver
  ( KindedResolver (..),
  )
where

import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver (..),
    ResolverValue (..),
    getArguments,
  )
import Data.Morpheus.Internal.Utils (toAssoc)
import Data.Morpheus.Server.Deriving.Internal.Resolver
  ( EXPLORE,
    useExploreResolvers,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( Kinded (..),
  )
import Data.Morpheus.Server.Deriving.Utils.Types
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseGQLValue (useDecodeValue),
    UseResolver (..),
  )
import Data.Morpheus.Server.Types.Kind
  ( CUSTOM,
    DerivingKind,
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.Server.Types.Types
  ( TypeGuard (..),
  )
import Data.Morpheus.Types.GQLScalar
  ( EncodeScalar (..),
  )
import Data.Morpheus.Types.GQLWrapper (EncodeWrapper (..))
import Relude

-- ENCODE GQL KIND
class KindedResolver ctx (k :: DerivingKind) (m :: Type -> Type) (a :: Type) where
  kindedResolver :: (MonadResolver m, UseResolver res gql val ~ ctx) => ctx -> Kinded k a -> m (ResolverValue m)

instance (UseResolver res gql val ~ ctx, EncodeWrapper f, res m a) => KindedResolver ctx WRAPPER m (f a) where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded WRAPPER (f a) -> m (ResolverValue m)
kindedResolver ctx
res = (a -> m (ResolverValue m)) -> f a -> m (ResolverValue m)
forall (wrapper :: * -> *) (m :: * -> *) a.
(EncodeWrapper wrapper, Monad m) =>
(a -> m (ResolverValue m)) -> wrapper a -> m (ResolverValue m)
forall (m :: * -> *) a.
Monad m =>
(a -> m (ResolverValue m)) -> f a -> m (ResolverValue m)
encodeWrapper (UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver ctx
UseResolver res gql val
res) (f a -> m (ResolverValue m))
-> (Kinded WRAPPER (f a) -> f a)
-> Kinded WRAPPER (f a)
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded WRAPPER (f a) -> f a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

instance (EncodeScalar a) => KindedResolver ctx SCALAR m a where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded SCALAR a -> m (ResolverValue m)
kindedResolver ctx
_ = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> (Kinded SCALAR a -> ResolverValue m)
-> Kinded SCALAR a
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Kinded SCALAR a -> ScalarValue)
-> Kinded SCALAR a
-> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScalarValue
forall a. EncodeScalar a => a -> ScalarValue
encodeScalar (a -> ScalarValue)
-> (Kinded SCALAR a -> a) -> Kinded SCALAR a -> ScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded SCALAR a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

instance (UseResolver res gql val ~ ctx, EXPLORE gql res m a) => KindedResolver ctx TYPE m a where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded TYPE a -> m (ResolverValue m)
kindedResolver ctx
ctx = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> (Kinded TYPE a -> ResolverValue m)
-> Kinded TYPE a
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UseResolver res gql val -> a -> ResolverValue m
forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers ctx
UseResolver res gql val
ctx (a -> ResolverValue m)
-> (Kinded TYPE a -> a) -> Kinded TYPE a -> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded TYPE a -> a
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

--  Map
instance (UseResolver res gql val ~ ctx, res m [(k, v)], Ord k) => KindedResolver ctx CUSTOM m (Map k v) where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (Map k v) -> m (ResolverValue m)
kindedResolver ctx
res = UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver ctx
UseResolver res gql val
res ([(k, v)] -> m (ResolverValue m))
-> (Kinded CUSTOM (Map k v) -> [(k, v)])
-> Kinded CUSTOM (Map k v)
-> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall a. Map k a -> [(k, a)]
forall k (m :: * -> *) a. IsMap k m => m a -> [(k, a)]
toAssoc (Map k v -> [(k, v)])
-> (Kinded CUSTOM (Map k v) -> Map k v)
-> Kinded CUSTOM (Map k v)
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kinded CUSTOM (Map k v) -> Map k v
forall (kind :: DerivingKind) a. Kinded kind a -> a
unkind

--  INTERFACE Types
instance (UseResolver res gql val ~ ctx, EXPLORE gql res m guard, EXPLORE gql res m union) => KindedResolver ctx CUSTOM m (TypeGuard guard union) where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (TypeGuard guard union) -> m (ResolverValue m)
kindedResolver ctx
ctx (Kinded (ResolveType union
value)) = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UseResolver res gql val -> union -> ResolverValue m
forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers ctx
UseResolver res gql val
ctx union
value)
  kindedResolver ctx
ctx (Kinded (ResolveInterface guard
value)) = ResolverValue m -> m (ResolverValue m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UseResolver res gql val -> guard -> ResolverValue m
forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers ctx
UseResolver res gql val
ctx guard
value)

instance (UseResolver res gql val ~ ctx, Generic a, res m b, val a) => KindedResolver ctx CUSTOM m (a -> b) where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (a -> b) -> m (ResolverValue m)
kindedResolver ctx
res (Kinded a -> b
f) =
    m (Arguments VALID)
forall (m :: * -> *). MonadResolver m => m (Arguments VALID)
getArguments
      m (Arguments VALID) -> (Arguments VALID -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverState a -> m a
forall a. ResolverState a -> m a
forall (m :: * -> *) a. MonadResolver m => ResolverState a -> m a
liftState (ResolverState a -> m a)
-> (Arguments VALID -> ResolverState a) -> Arguments VALID -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx -> ValidValue -> ResolverState a
forall a. val a => ctx -> ValidValue -> ResolverState a
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> ValidValue -> ResolverState a
useDecodeValue ctx
res (ValidValue -> ResolverState a)
-> (Arguments VALID -> ValidValue)
-> Arguments VALID
-> ResolverState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments VALID -> ValidValue
argumentsToObject
      m a -> (a -> m (ResolverValue m)) -> m (ResolverValue m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver ctx
UseResolver res gql val
res (b -> m (ResolverValue m)) -> (a -> b) -> a -> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance (UseResolver res gql val ~ ctx, res m a) => KindedResolver ctx CUSTOM m (m a) where
  kindedResolver :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
(MonadResolver m, UseResolver res gql val ~ ctx) =>
ctx -> Kinded CUSTOM (m a) -> m (ResolverValue m)
kindedResolver ctx
res (Kinded m a
value) = m a
value m a -> (a -> m (ResolverValue m)) -> m (ResolverValue m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver ctx
UseResolver res gql val
res