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

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

import Control.Monad.Except (MonadError)
import qualified Data.Map as M
import Data.Morpheus.App.Internal.Resolving
  ( MonadResolver (..),
    ResolverValue (..),
    getArguments,
  )
import Data.Morpheus.Server.Deriving.Internal.Resolve.Explore
import Data.Morpheus.Server.Deriving.Utils.AST
import Data.Morpheus.Server.Deriving.Utils.Proxy
  ( ContextValue (..),
  )
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (dirArgs),
    UseResolver (..),
    UseValue (useDecodeValue),
  )
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 Data.Morpheus.Types.Internal.AST
  ( GQLError,
  )
import Relude

-- ENCODE GQL KIND
class KindedResolver gql res val (kind :: DerivingKind) (m :: Type -> Type) (a :: Type) where
  kindedResolver :: UseResolver res gql val -> ContextValue kind a -> m (ResolverValue m)

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

instance (EncodeScalar a, Monad m) => KindedResolver gql res val SCALAR m a where
  kindedResolver :: UseResolver res gql val
-> ContextValue SCALAR a -> m (ResolverValue m)
kindedResolver UseResolver res gql val
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncodeScalar a => a -> ScalarValue
encodeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

instance (MonadError GQLError m, EXPLORE gql res m a) => KindedResolver gql res val TYPE m a where
  kindedResolver :: UseResolver res gql val
-> ContextValue TYPE a -> m (ResolverValue m)
kindedResolver UseResolver res gql val
ctx = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 UseResolver res gql val
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

--  Map
instance (Monad m, res m [(k, v)]) => KindedResolver gql res val CUSTOM m (Map k v) where
  kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (Map k v) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res = forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

--  INTERFACE Types
instance (MonadError GQLError m, EXPLORE gql res m guard, EXPLORE gql res m union) => KindedResolver gql res val CUSTOM m (TypeGuard guard union) where
  kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (TypeGuard guard union)
-> m (ResolverValue m)
kindedResolver UseResolver res gql val
ctx (ContextValue (ResolveType union
value)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 UseResolver res gql val
ctx union
value)
  kindedResolver UseResolver res gql val
ctx (ContextValue (ResolveInterface guard
value)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 UseResolver res gql val
ctx guard
value)

instance (Generic a, res m b, MonadResolver m, val a) => KindedResolver gql res val CUSTOM m (a -> b) where
  kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (a -> b) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res (ContextValue a -> b
f) =
    forall (m :: * -> *). MonadResolver m => m (Arguments VALID)
getArguments
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a b. (a -> b) -> a -> b
$ forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
resDrv UseResolver res gql val
res) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments VALID -> ValidValue
argumentsToObject
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

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