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

module Data.Morpheus.Server.Deriving.Schema
  ( compileTimeSchemaValidation,
    deriveSchema,
    SCHEMA,
  )
where

import Data.Morpheus.Core (defaultConfig, validateSchema)
import Data.Morpheus.Internal.Ext (GQLResult)
import Data.Morpheus.Server.Deriving.Internal.Schema.Internal
  ( fromSchema,
  )
import Data.Morpheus.Server.Deriving.Internal.Schema.Type
  ( useDeriveObject,
  )
import Data.Morpheus.Server.Types.GQLType
  ( GQLType (..),
    IgnoredResolver,
    ignoreUndefined,
    withGQL,
  )
import Data.Morpheus.Server.Types.SchemaT
  ( toSchema,
  )
import Data.Morpheus.Types.Internal.AST
  ( CONST,
    Schema (..),
  )
import Language.Haskell.TH (Exp, Q)
import Relude

type SCHEMA qu mu su = (GQLType (qu IgnoredResolver), GQLType (mu IgnoredResolver), GQLType (su IgnoredResolver))

-- | normal morpheus server validates schema at runtime (after the schema derivation).
--   this method allows you to validate it at compile time.
compileTimeSchemaValidation :: (SCHEMA qu mu su) => proxy (root m event qu mu su) -> Q Exp
compileTimeSchemaValidation :: forall {k} {k} {k} (qu :: (* -> *) -> *) (mu :: (* -> *) -> *)
       (su :: (* -> *) -> *) (proxy :: k -> *)
       (root :: k
                -> k -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (m :: k) (event :: k).
SCHEMA qu mu su =>
proxy (root m event qu mu su) -> Q Exp
compileTimeSchemaValidation = GQLResult (Schema VALID) -> Q Exp
fromSchema forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {k} {k} {k}
       (root :: k
                -> k -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (f :: k -> *) (m :: k) (e :: k) (qu :: (* -> *) -> *)
       (mu :: (* -> *) -> *) (su :: (* -> *) -> *).
SCHEMA qu mu su =>
f (root m e qu mu su) -> GQLResult (Schema CONST)
deriveSchema forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (s :: Stage).
ValidateSchema s =>
Bool -> Config -> Schema s -> GQLResult (Schema VALID)
validateSchema Bool
True Config
defaultConfig)

deriveSchema :: forall root f m e qu mu su. SCHEMA qu mu su => f (root m e qu mu su) -> GQLResult (Schema CONST)
deriveSchema :: forall {k} {k} {k}
       (root :: k
                -> k -> ((* -> *) -> *) -> ((* -> *) -> *) -> ((* -> *) -> *) -> k)
       (f :: k -> *) (m :: k) (e :: k) (qu :: (* -> *) -> *)
       (mu :: (* -> *) -> *) (su :: (* -> *) -> *).
SCHEMA qu mu su =>
f (root m e qu mu su) -> GQLResult (Schema CONST)
deriveSchema f (root m e qu mu su)
_ =
  forall (c :: TypeCategory).
SchemaT
  c
  (TypeDefinition OBJECT CONST, Maybe (TypeDefinition OBJECT CONST),
   Maybe (TypeDefinition OBJECT CONST))
-> GQLResult (Schema CONST)
toSchema
    ( (,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
useDeriveObject UseGQLType GQLType
withGQL (forall {k} (t :: k). Proxy t
Proxy @(qu IgnoredResolver))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
useDeriveObject UseGQLType GQLType
withGQL) (forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a)
ignoreUndefined (forall {k} (t :: k). Proxy t
Proxy @(mu IgnoredResolver)))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> SchemaT OUT (TypeDefinition OBJECT CONST)
useDeriveObject UseGQLType GQLType
withGQL) (forall (f :: * -> *) a. GQLType a => f a -> Maybe (f a)
ignoreUndefined (forall {k} (t :: k). Proxy t
Proxy @(su IgnoredResolver)))
    )