{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Schema.Internal
( KindedType (..),
TyContentM,
TyContent,
fromSchema,
lookupDescription,
lookupFieldContent,
)
where
import qualified Data.Map as M
import Data.Morpheus.Internal.Ext
( GQLResult,
Result (Failure, Success, errors),
)
import Data.Morpheus.Server.Deriving.Utils.Kinded
( KindedType (..),
)
import Data.Morpheus.Server.Types.GQLType
( GQLType (..),
)
import Data.Morpheus.Server.Types.SchemaT
( SchemaT,
)
import Data.Morpheus.Types.Internal.AST
( CONST,
Description,
FieldContent (..),
Schema (..),
TRUE,
VALID,
)
import Language.Haskell.TH (Exp, Q)
import Relude hiding (empty)
lookupDescription :: GQLType a => f a -> Text -> Maybe Description
lookupDescription :: forall a (f :: * -> *). GQLType a => f a -> Text -> Maybe Text
lookupDescription f a
proxy Text
name = Text
name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall a (f :: * -> *). GQLType a => f a -> Map Text Text
getDescriptions f a
proxy
lookupFieldContent ::
GQLType a =>
KindedType kind a ->
Text ->
Maybe (FieldContent TRUE kind CONST)
lookupFieldContent :: forall a (kind :: TypeCategory).
GQLType a =>
KindedType kind a -> Text -> Maybe (FieldContent TRUE kind CONST)
lookupFieldContent proxy :: KindedType kind a
proxy@KindedType kind a
InputType Text
key = forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent ('IN <=? cat) cat s
DefaultInputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
key forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall a (f :: * -> *). GQLType a => f a -> Map Text (Value CONST)
defaultValues KindedType kind a
proxy
lookupFieldContent KindedType kind a
OutputType Text
_ = forall a. Maybe a
Nothing
fromSchema :: GQLResult (Schema VALID) -> Q Exp
fromSchema :: GQLResult (Schema VALID) -> Q Exp
fromSchema Success {} = [|()|]
fromSchema Failure {NonEmpty GQLError
errors :: NonEmpty GQLError
errors :: forall err a. Result err a -> NonEmpty err
errors} = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall b a. (Show a, IsString b) => a -> b
show NonEmpty GQLError
errors)
type TyContentM kind = SchemaT kind (TyContent kind)
type TyContent kind = Maybe (FieldContent TRUE kind CONST)