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

module Data.Morpheus.Server.Deriving.Internal.Resolver
  ( useExploreResolvers,
    useObjectResolvers,
    EXPLORE,
  )
where

import Control.Monad.Except (MonadError)
import Data.Morpheus.App.Internal.Resolving
  ( ObjectTypeResolver (..),
    ResolverState,
    ResolverValue (..),
    mkEnum,
    mkObject,
    mkUnion,
    requireObject,
  )
import Data.Morpheus.Generic
  ( GRep,
    GRepFun (..),
    GRepValue (..),
    deriveValue,
  )
import Data.Morpheus.Server.Deriving.Internal.Directive
  ( toFieldRes,
    visitEnumName,
  )
import Data.Morpheus.Server.Deriving.Utils.Kinded (inputType)
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (..),
    UseGQLType (..),
    UseResolver (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( GQLError,
  )
import GHC.Generics (Generic (Rep))
import Relude

fromGRep :: (MonadError GQLError m, gql a) => UseDeriving gql val -> f a -> GRepValue (m (ResolverValue m)) -> ResolverValue m
fromGRep :: forall (m :: * -> *) (gql :: * -> Constraint) a
       (val :: * -> Constraint) (f :: * -> *).
(MonadError GQLError m, gql a) =>
UseDeriving gql val
-> f a -> GRepValue (m (ResolverValue m)) -> ResolverValue m
fromGRep UseDeriving gql val
ctx f a
prx GRepValueEnum {TypeName
enumTypeName :: TypeName
enumVariantName :: TypeName
enumTypeName :: forall v. GRepValue v -> TypeName
enumVariantName :: forall v. GRepValue v -> TypeName
..} = TypeName -> ResolverValue m
forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum (UseDeriving gql val -> f a -> TypeName -> TypeName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName UseDeriving gql val
ctx f a
prx TypeName
enumVariantName)
fromGRep UseDeriving gql val
ctx f a
prx GRepValueObject {[GRepField (m (ResolverValue m))]
TypeName
objectTypeName :: TypeName
objectFields :: [GRepField (m (ResolverValue m))]
objectTypeName :: forall v. GRepValue v -> TypeName
objectFields :: forall v. GRepValue v -> [GRepField v]
..} = TypeName -> [ResolverEntry m] -> ResolverValue m
forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue m
mkObject TypeName
objectTypeName (UseDeriving gql val
-> f a -> GRepField (m (ResolverValue m)) -> ResolverEntry m
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> GRepField v -> (FieldName, v)
toFieldRes UseDeriving gql val
ctx f a
prx (GRepField (m (ResolverValue m)) -> ResolverEntry m)
-> [GRepField (m (ResolverValue m))] -> [ResolverEntry m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GRepField (m (ResolverValue m))]
objectFields)
fromGRep UseDeriving gql val
ctx f a
prx GRepValueUnion {[GRepField (m (ResolverValue m))]
TypeName
unionTypeName :: TypeName
unionVariantName :: TypeName
unionFields :: [GRepField (m (ResolverValue m))]
unionTypeName :: forall v. GRepValue v -> TypeName
unionVariantName :: forall v. GRepValue v -> TypeName
unionFields :: forall v. GRepValue v -> [GRepField v]
..} = TypeName -> [ResolverEntry m] -> ResolverValue m
forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
unionVariantName (UseDeriving gql val
-> f a -> GRepField (m (ResolverValue m)) -> ResolverEntry m
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> GRepField v -> (FieldName, v)
toFieldRes UseDeriving gql val
ctx f a
prx (GRepField (m (ResolverValue m)) -> ResolverEntry m)
-> [GRepField (m (ResolverValue m))] -> [ResolverEntry m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GRepField (m (ResolverValue m))]
unionFields)
fromGRep UseDeriving gql val
_ f a
_ GRepValueUnionRef {m (ResolverValue m)
TypeName
unionRefTypeName :: TypeName
unionRefValue :: m (ResolverValue m)
unionRefTypeName :: forall v. GRepValue v -> TypeName
unionRefValue :: forall v. GRepValue v -> v
..} = m (ResolverValue m) -> ResolverValue m
forall (m :: * -> *). m (ResolverValue m) -> ResolverValue m
ResLazy (Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
forall (m :: * -> *).
Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
ResObject (TypeName -> Maybe TypeName
forall a. a -> Maybe a
Just TypeName
unionRefTypeName) (ObjectTypeResolver m -> ResolverValue m)
-> m (ObjectTypeResolver m) -> m (ResolverValue m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (ResolverValue m)
unionRefValue m (ResolverValue m)
-> (ResolverValue m -> m (ObjectTypeResolver m))
-> m (ObjectTypeResolver m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ResolverValue m -> m (ObjectTypeResolver m)
forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject))

toOptions :: UseResolver res gql val -> GRepFun gql (res m) Identity (m (ResolverValue m))
toOptions :: forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver res gql val
ctx =
  GRepFun
    { grepFun :: forall a. res m a => Identity a -> m (ResolverValue m)
grepFun = 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 UseResolver res gql val
ctx (a -> m (ResolverValue m))
-> (Identity a -> a) -> Identity a -> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity,
      grepTypename :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeName
grepTypename = UseResolver res gql val -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
UseResolver res gql val -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename UseResolver res gql val
ctx (CatType IN a -> TypeName)
-> (proxy a -> CatType IN a) -> proxy a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType,
      grepWrappers :: forall (proxy :: * -> *) a. gql a => proxy a -> TypeWrapper
grepWrappers = UseResolver res gql val -> CatType IN a -> TypeWrapper
forall a (c :: TypeCategory).
gql a =>
UseResolver res gql val -> CatType c a -> TypeWrapper
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeWrapper
useWrappers UseResolver res gql val
ctx (CatType IN a -> TypeWrapper)
-> (proxy a -> CatType IN a) -> proxy a -> TypeWrapper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType
    }

useExploreResolvers ::
  (MonadError GQLError m, EXPLORE gql res m a) =>
  UseResolver res gql val ->
  a ->
  ResolverValue m
useExploreResolvers :: 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
res a
v = UseDeriving gql val
-> Identity a -> GRepValue (m (ResolverValue m)) -> ResolverValue m
forall (m :: * -> *) (gql :: * -> Constraint) a
       (val :: * -> Constraint) (f :: * -> *).
(MonadError GQLError m, gql a) =>
UseDeriving gql val
-> f a -> GRepValue (m (ResolverValue m)) -> ResolverValue m
fromGRep (UseResolver res gql val -> UseDeriving gql val
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
resDrv UseResolver res gql val
res) (a -> Identity a
forall a. a -> Identity a
Identity a
v) (GRepFun gql (res m) Identity (m (ResolverValue m))
-> a -> GRepValue (m (ResolverValue m))
forall a (gql :: * -> Constraint) (constraint :: * -> Constraint)
       value.
(Generic a, GRep gql constraint value (Rep a), gql a) =>
GRepFun gql constraint Identity value -> a -> GRepValue value
deriveValue (UseResolver res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
forall (res :: (* -> *) -> * -> Constraint)
       (gql :: * -> Constraint) (val :: * -> Constraint) (m :: * -> *).
UseResolver res gql val
-> GRepFun gql (res m) Identity (m (ResolverValue m))
toOptions UseResolver res gql val
res) a
v)

useObjectResolvers ::
  (MonadError GQLError m, EXPLORE gql res m a) =>
  UseResolver res gql val ->
  a ->
  ResolverState (ObjectTypeResolver m)
useObjectResolvers :: forall (m :: * -> *) (gql :: * -> Constraint)
       (res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val
-> a -> ResolverState (ObjectTypeResolver m)
useObjectResolvers UseResolver res gql val
ctx a
value = ResolverValue m
-> ResolverStateT () Identity (ObjectTypeResolver m)
forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject (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 UseResolver res gql val
ctx a
value)

type EXPLORE gql res (m :: Type -> Type) a =
  ( Generic a,
    GRep gql (res m) (m (ResolverValue m)) (Rep a),
    gql a
  )