morpheus-graphql-server 0.24.3 → 0.25.0

raw patch · 19 files changed

+175/−241 lines, 19 filesdep ~morpheus-graphql-appdep ~morpheus-graphql-coredep ~morpheus-graphql-subscriptionsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: morpheus-graphql-app, morpheus-graphql-core, morpheus-graphql-subscriptions, morpheus-graphql-tests

API changes (from Hackage documentation)

Files

• morpheus-graphql-server.cabal +8/−7
• src/Data/Morpheus/Server/CodeGen/Internal.hs +12/−0
• src/Data/Morpheus/Server/Deriving/Named/EncodeType.hs +7/−5
• src/Data/Morpheus/Server/Deriving/Named/EncodeValue.hs +11/−5
• src/Data/Morpheus/Server/Deriving/Schema.hs +5/−0
• src/Data/Morpheus/Server/Deriving/Schema/Directive.hs +25/−13
• src/Data/Morpheus/Server/Deriving/Schema/Enum.hs +1/−6
• src/Data/Morpheus/Server/Deriving/Schema/Internal.hs +0/−18
• src/Data/Morpheus/Server/Deriving/Schema/Object.hs +3/−9
• src/Data/Morpheus/Server/Deriving/Schema/TypeContent.hs +1/−1
• src/Data/Morpheus/Server/NamedResolvers.hs +21/−9
• src/Data/Morpheus/Server/Resolvers.hs +6/−0
• src/Data/Morpheus/Server/Types.hs +6/−25
• src/Data/Morpheus/Server/Types/DirectiveDefinitions.hs +17/−5
• src/Data/Morpheus/Server/Types/Directives.hs +16/−7
• src/Data/Morpheus/Server/Types/GQLType.hs +30/−70
• src/Data/Morpheus/Server/Types/Internal.hs +2/−60
• src/Data/Morpheus/Server/Types/SchemaT.hs +0/−1
• src/Data/Morpheus/Server/Types/Visitors.hs +4/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morpheus-graphql-server-version:        0.24.3+version:        0.25.0 synopsis:       Morpheus GraphQL description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -276,6 +276,7 @@ library   exposed-modules:       Data.Morpheus.Server+      Data.Morpheus.Server.CodeGen.Internal       Data.Morpheus.Server.Resolvers       Data.Morpheus.Server.Types   other-modules:@@ -320,8 +321,8 @@     , base >=4.7.0 && <5.0.0     , bytestring >=0.10.4 && <0.12.0     , containers >=0.4.2.1 && <0.7.0-    , morpheus-graphql-app >=0.24.0 && <0.25.0-    , morpheus-graphql-core >=0.24.0 && <0.25.0+    , morpheus-graphql-app >=0.25.0 && <0.26.0+    , morpheus-graphql-core >=0.25.0 && <0.26.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , template-haskell >=2.0.0 && <3.0.0@@ -365,11 +366,11 @@     , bytestring >=0.10.4 && <0.12.0     , containers >=0.4.2.1 && <0.7.0     , file-embed >=0.0.10 && <1.0.0-    , morpheus-graphql-app >=0.24.0 && <0.25.0-    , morpheus-graphql-core >=0.24.0 && <0.25.0+    , morpheus-graphql-app >=0.25.0 && <0.26.0+    , morpheus-graphql-core >=0.25.0 && <0.26.0     , morpheus-graphql-server-    , morpheus-graphql-subscriptions >=0.24.0 && <0.25.0-    , morpheus-graphql-tests >=0.24.0 && <0.25.0+    , morpheus-graphql-subscriptions >=0.25.0 && <0.26.0+    , morpheus-graphql-tests >=0.25.0 && <0.26.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , tasty >=0.1.0 && <1.5.0

@@ -0,0 +1,12 @@+module Data.Morpheus.Server.CodeGen.Internal+  ( Typeable,+    Text,+    Generic,+  )+where++import Data.Data (Typeable)+-- add type class instances+import Data.Morpheus.Server.Deriving.App ()+import Data.Text (Text)+import GHC.Generics (Generic)

@@ -22,7 +22,6 @@   ( LiftOperation,     NamedResolver (..),     Resolver,-    ResolverState,     liftResolverState,   ) import Data.Morpheus.Server.Deriving.Decode@@ -37,7 +36,7 @@   ) import Data.Morpheus.Server.Deriving.Utils.GTraversable import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy))-import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..), ResolveNamed (Dep, resolveNamed))+import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..), ResolveNamed (..)) import Data.Morpheus.Server.Types.GQLType   ( GQLType,     KIND,@@ -90,12 +89,15 @@   deriveNamedResolver _ =     [ NamedResolver         { resolverName = getTypeName (Proxy @a),-          resolver = resolve >=> encodeResolverValue+          resolverFun = resolve >=> encodeResolverValue         }     ]     where-      resolve :: ValidValue -> Resolver o e m a-      resolve x = liftResolverState (decode x :: ResolverState (Dep a)) >>= resolveNamed+      resolve :: [ValidValue] -> Resolver o e m [Maybe a]+      resolve xs = traverse decodeArg xs >>= resolveBatched++      decodeArg :: ValidValue -> Resolver o e m (Dep a)+      decodeArg = liftResolverState . decode  instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (NamedResolverT m a) where   deriveNamedResolver _ = deriveNamedResolver (KindedProxy :: KindedProxy (KIND a) a)

@@ -91,10 +91,13 @@ import GHC.Generics   ( Generic (..),   )-import Relude+import Relude hiding (empty) -encodeResolverValue :: (MonadError GQLError m, FieldConstraint m a) => a -> m (NamedResolverResult m)-encodeResolverValue x = convertNamedNode (Identity x) (getFieldValues x)+encodeResolverValue :: (MonadError GQLError m, FieldConstraint m a) => [Maybe a] -> m [NamedResolverResult m]+encodeResolverValue x = traverse encodeNode x+  where+    encodeNode (Just v) = convertNamedNode (Identity x) (getFieldValues v)+    encodeNode Nothing = pure NamedNullResolver  type FieldConstraint m a =   ( GQLType a,@@ -137,9 +140,12 @@       name :: TypeName       name = getTypeName (Proxy @a)       encodeRef :: Monad m => NamedResolverT m a -> m (ResolverValue m)-      encodeRef (Ref x) = pure $ ResRef (NamedResolverRef name . replaceValue . toJSON <$> x)+      encodeRef (Ref x) = pure $ ResRef $ packRef name <$> x       encodeRef (Value value) = value >>= encodeField-      encodeRef (Refs refs) = mkList . map (ResRef . pure . NamedResolverRef name . replaceValue . toJSON) <$> refs+      encodeRef (Refs refs) = mkList . map (ResRef . pure . packRef name) <$> refs++packRef :: ToJSON a => TypeName -> a -> NamedResolverRef+packRef name v = NamedResolverRef name [replaceValue $ toJSON v]  instance   ( Decode a,

@@ -94,6 +94,7 @@     OUT,     QUERY,     SUBSCRIPTION,+    ScalarDefinition (..),     Schema (..),     TRUE,     TypeCategory,@@ -102,6 +103,7 @@     TypeName,     TypeRef (..),     UnionMember (memberName),+    Value,     fieldsToArguments,     mkField,   )@@ -192,6 +194,9 @@  instance DeriveType cat a => DeriveKindedType cat CUSTOM (Resolver o e m a) where   deriveKindedType _ = deriveType (Proxy @a)++instance DeriveKindedType cat CUSTOM (Value CONST) where+  deriveKindedType = insertTypeContent (const $ pure $ DataScalar $ ScalarDefinition pure) . setKind (Proxy @LEAF)  instance DeriveType cat [(k, v)] => DeriveKindedType cat CUSTOM (Map k v) where   deriveKindedType _ = deriveType (Proxy @[(k, v)])

@@ -5,7 +5,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -22,18 +21,20 @@     visitEnumValueDescription,     visitFieldDescription,     visitTypeDescription,+    visitFieldDefaultValue,+    visitFieldContent,     visitEnumName,     visitFieldName,     toFieldRes,   ) where -import Control.Monad.Except (throwError) import qualified Data.HashMap.Lazy as HM-import Data.Morpheus.Internal.Ext (resultOr, unsafeFromList)+import Data.Morpheus.Internal.Ext (unsafeFromList) import Data.Morpheus.Internal.Utils (Empty (..), fromElems) import Data.Morpheus.Server.Deriving.Utils.Kinded   ( KindedProxy (..),+    KindedType (..),   ) import Data.Morpheus.Server.Deriving.Utils.Types (FieldRep (..)) import Data.Morpheus.Server.Types.Directives@@ -48,6 +49,7 @@     GQLType (..),     applyEnumDescription,     applyEnumName,+    applyFieldDefaultValue,     applyFieldDescription,     applyFieldName,     applyTypeDescription,@@ -57,7 +59,6 @@     deriveTypename,     encodeArguments,   )-import Data.Morpheus.Server.Types.Internal import Data.Morpheus.Server.Types.SchemaT   ( SchemaT,     insertDirectiveDefinition,@@ -70,10 +71,13 @@     Directive (..),     DirectiveDefinition (..),     Directives,+    FieldContent (..),     FieldName,     IN,     Position (Position),+    TRUE,     TypeName,+    Value,   ) import GHC.Generics () import GHC.TypeLits ()@@ -97,7 +101,7 @@   pure     ( DirectiveDefinition         { directiveDefinitionName = deriveDirectiveName proxy,-          directiveDefinitionDescription = description proxy,+          directiveDefinitionDescription = visitTypeDescription proxy Nothing,           directiveDefinitionArgs,           directiveDefinitionLocations = getLocations proxy         }@@ -115,7 +119,7 @@ toDirectiveTuple (DirectiveUsage x) = do   insertDirective (deriveDirectiveDefinition x) x   let directiveName = deriveDirectiveName (Identity x)-  args <- toList <$> resultOr (const $ throwError "TODO: fix me") pure (encodeArguments x)+  args <- toList <$> encodeArguments x   directiveArgs <- fromElems (map editArg args)   pure     ( directiveName,@@ -150,9 +154,6 @@ getFieldDirectiveUsages :: GQLType a => FieldName -> f a -> [DirectiveUsage] getFieldDirectiveUsages name proxy = getDirHM name $ fieldDirectives $ directives proxy -getOptions :: GQLType a => f a -> GQLTypeOptions-getOptions proxy = typeOptions proxy defaultTypeOptions- -- derive directives deriveEnumDirectives :: GQLType a => f a -> TypeName -> SchemaT c (Directives CONST) deriveEnumDirectives proxy name = deriveDirectiveUsages $ filter isIncluded $ getEnumDirectiveUsages proxy name@@ -164,22 +165,33 @@ deriveTypeDirectives proxy = deriveDirectiveUsages $ filter isIncluded $ typeDirectives $ directives proxy  -- visit+ visitEnumValueDescription :: GQLType a => f a -> TypeName -> Maybe Description -> Maybe Description visitEnumValueDescription proxy name desc = foldr applyEnumDescription desc (getEnumDirectiveUsages proxy name)  visitEnumName :: GQLType a => f a -> TypeName -> TypeName-visitEnumName proxy name = foldr applyEnumName (withTypeDirectives $ withOptions name) (getEnumDirectiveUsages proxy name)+visitEnumName proxy name = foldr applyEnumName (withTypeDirectives name) (getEnumDirectiveUsages proxy name)   where-    withOptions = fromString . constructorTagModifier (getOptions proxy) . toString     withTypeDirectives dirName = foldr applyTypeEnumNames dirName (typeDirectives $ directives proxy)  visitFieldDescription :: GQLType a => f a -> FieldName -> Maybe Description -> Maybe Description visitFieldDescription proxy name desc = foldr applyFieldDescription desc (getFieldDirectiveUsages name proxy) +visitFieldDefaultValue :: GQLType a => f a -> FieldName -> Maybe (Value CONST) -> Maybe (Value CONST)+visitFieldDefaultValue proxy name desc = foldr applyFieldDefaultValue desc (getFieldDirectiveUsages name proxy)++visitFieldContent ::+  GQLType a =>+  KindedType kind a ->+  FieldName ->+  Maybe (FieldContent TRUE kind CONST) ->+  Maybe (FieldContent TRUE kind CONST)+visitFieldContent proxy@InputType name x = DefaultInputValue <$> visitFieldDefaultValue proxy name (defaultInputValue <$> x)+visitFieldContent OutputType _ x = x+ applyGQLFieldOptions :: (GQLType a) => f a -> FieldName -> FieldName-applyGQLFieldOptions proxy = withTypeDirectives . withOptions+applyGQLFieldOptions proxy = withTypeDirectives   where-    withOptions = fromString . fieldLabelModifier (getOptions proxy) . toString     withTypeDirectives name = foldr applyTypeFieldNames name (typeDirectives $ directives proxy)  visitFieldName :: GQLType a => f a -> FieldName -> FieldName

@@ -12,9 +12,6 @@     visitEnumName,     visitEnumValueDescription,   )-import Data.Morpheus.Server.Deriving.Schema.Internal-  ( lookupDescription,-  ) import Data.Morpheus.Server.Deriving.Utils.Kinded   ( KindedType (..),   )@@ -36,7 +33,6 @@     mkEnumContent,     mkType,     unitTypeName,-    unpackName,   )  buildEnumTypeContent :: GQLType a => KindedType kind a -> [TypeName] -> SchemaT c (TypeContent TRUE kind CONST)@@ -46,11 +42,10 @@ mkEnumValue :: GQLType a => f a -> TypeName -> SchemaT c (DataEnumValue CONST) mkEnumValue proxy enumName = do   enumDirectives <- deriveEnumDirectives proxy enumName-  let desc = lookupDescription proxy (unpackName enumName)   pure     DataEnumValue       { enumName = visitEnumName proxy enumName,-        enumDescription = visitEnumValueDescription proxy enumName desc,+        enumDescription = visitEnumValueDescription proxy enumName Nothing,         ..       } 

@@ -23,14 +23,11 @@     TyContentM,     TyContent,     fromSchema,-    lookupDescription,-    lookupFieldContent,   ) where  -- MORPHEUS -import qualified Data.Map as M import Data.Morpheus.Internal.Ext   ( GQLResult,     Result (Failure, Success, errors),@@ -38,15 +35,11 @@ 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,@@ -54,17 +47,6 @@   ) import Language.Haskell.TH (Exp, Q) import Relude hiding (empty)--lookupDescription :: GQLType a => f a -> Text -> Maybe Description-lookupDescription proxy name = name `M.lookup` getDescriptions proxy--lookupFieldContent ::-  GQLType a =>-  KindedType kind a ->-  Text ->-  Maybe (FieldContent TRUE kind CONST)-lookupFieldContent proxy@InputType key = DefaultInputValue <$> key `M.lookup` defaultValues proxy-lookupFieldContent OutputType _ = Nothing  fromSchema :: GQLResult (Schema VALID) -> Q Exp fromSchema Success {} = [|()|]

@@ -21,14 +21,11 @@   ) import Data.Morpheus.Server.Deriving.Schema.Directive   ( deriveFieldDirectives,+    visitFieldContent,     visitFieldDescription,     visitFieldName,   ) import Data.Morpheus.Server.Deriving.Schema.Enum (defineEnumUnit)-import Data.Morpheus.Server.Deriving.Schema.Internal-  ( lookupDescription,-    lookupFieldContent,-  ) import Data.Morpheus.Server.Deriving.Utils   ( ConsRep (..),     FieldRep (..),@@ -63,7 +60,6 @@     msg,     unitFieldName,     unitTypeName,-    unpackName,     unsafeFromFields,   ) import Relude hiding (empty)@@ -135,10 +131,8 @@   pure     FieldDefinition       { fieldName = visitFieldName proxy fieldName,-        fieldDescription = visitFieldDescription proxy fieldName (lookupDescription proxy key),-        fieldContent = lookupFieldContent proxy key <|> fieldContent,+        fieldDescription = visitFieldDescription proxy fieldName Nothing,+        fieldContent = visitFieldContent proxy fieldName fieldContent,         fieldDirectives = dirs,         ..       }-  where-    key = unpackName fieldName

@@ -69,7 +69,7 @@       dirs <- deriveTypeDirectives proxy       pure $         TypeDefinition-          (visitTypeDescription proxy $ description proxy)+          (visitTypeDescription proxy Nothing)           (deriveTypename proxy)           dirs           content

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -11,14 +12,17 @@   ( ResolveNamed (..),     NamedResolverT (..),     resolve,+    useBatched,   ) where +import Control.Monad.Except import Data.Aeson (ToJSON) import Data.Morpheus.Types.ID (ID)+import Data.Morpheus.Types.Internal.AST (GQLError, internal) import Relude -instance Monad m => ResolveNamed m ID where+instance (Monad m) => ResolveNamed m ID where   type Dep ID = ID   resolveNamed = pure @@ -26,18 +30,26 @@   type Dep Text = Text   resolveNamed = pure -class (ToJSON (Dep a)) => ResolveNamed (m :: Type -> Type) a where+useBatched :: (ResolveNamed m a, MonadError GQLError m) => Dep a -> m a+useBatched x = resolveBatched [x] >>= res+  where+    res [Just v] = pure v+    res _ = throwError (internal "named resolver should return single value for single argument")++class (ToJSON (Dep a)) => ResolveNamed (m :: Type -> Type) (a :: Type) where   type Dep a :: Type-  resolveNamed :: Monad m => Dep a -> m a+  resolveBatched :: Monad m => [Dep a] -> m [Maybe a]+  resolveBatched = traverse (fmap Just . resolveNamed) -instance (ResolveNamed m a) => ResolveNamed (m :: Type -> Type) (Maybe a) where-  type Dep (Maybe a) = Maybe (Dep a)-  resolveNamed (Just x) = Just <$> resolveNamed x-  resolveNamed Nothing = pure Nothing+  resolveNamed :: Monad m => Dep a -> m a -instance (ResolveNamed m a) => ResolveNamed (m :: Type -> Type) [a] where+instance (ResolveNamed m a, MonadError GQLError m) => ResolveNamed (m :: Type -> Type) [a] where   type Dep [a] = [Dep a]-  resolveNamed = traverse resolveNamed+  resolveNamed _ = throwError (internal "named resolver instance [a] should not be called")++instance (ResolveNamed m a, MonadError GQLError m) => ResolveNamed (m :: Type -> Type) (Maybe a) where+  type Dep (Maybe a) = Maybe (Dep a)+  resolveNamed _ = throwError (internal "named resolver instance Maybe should not be called")  data NamedResolverT (m :: Type -> Type) a where   Ref :: ResolveNamed m a => m (Dep a) -> NamedResolverT m a

@@ -23,11 +23,17 @@     ResolverQ,     ResolverM,     ResolverS,+    useBatched,   ) where  import Data.Morpheus.App.Internal.Resolving (PushEvents (pushEvents), Resolver, WithOperation) import Data.Morpheus.Server.NamedResolvers+  ( NamedResolverT (..),+    ResolveNamed (..),+    resolve,+    useBatched,+  ) import Data.Morpheus.Server.Types.Types   ( Undefined (..),   )

@@ -11,15 +11,7 @@  -- | GQL Types module Data.Morpheus.Server.Types-  ( GQLType-      ( KIND,-        description,-        getDescriptions,-        typeOptions,-        getDirectives,-        defaultValues,-        directives-      ),+  ( GQLType (KIND, directives),     EncodeScalar (..),     EncodeWrapper (..),     DecodeScalar (..),@@ -36,7 +28,6 @@     lift,     WithOperation,     subscribe,-    unsafeInternalContext,     ResolverContext (..),     SubscriptionField,     App,@@ -45,13 +36,6 @@     TypeGuard (..),     Arg (..), -    -- * GQLType naming configuration-    GQLTypeOptions,-    defaultTypeOptions,-    fieldLabelModifier,-    constructorTagModifier,-    typeNameModifier,-     -- * GQL directives API     Prefixes (..),     VisitType (..),@@ -67,7 +51,6 @@     GQLDirective (..),     Deprecated (..),     Describe (..),-    dropNamespaceOptions,     SCALAR,     DerivingKind (..),     TYPE,@@ -78,6 +61,8 @@     Rename (..),     InputTypeNamespace (..),     DropNamespace (..),+    DefaultValue (..),+    Value (..),   ) where @@ -90,7 +75,6 @@     SubscriptionField,     WithOperation,     subscribe,-    unsafeInternalContext,   ) import Data.Morpheus.Core   ( RenderGQL,@@ -102,7 +86,8 @@     defaultRootResolver,   ) import Data.Morpheus.Server.Types.DirectiveDefinitions-  ( Deprecated (..),+  ( DefaultValue (..),+    Deprecated (..),     Describe (..),     DropNamespace (..),     Prefixes (..),@@ -118,11 +103,6 @@     fieldDirective',     typeDirective,   )-import Data.Morpheus.Server.Types.Internal-  ( GQLTypeOptions (..),-    defaultTypeOptions,-    dropNamespaceOptions,-  ) import Data.Morpheus.Server.Types.Kind   ( CUSTOM,     DerivingKind (..),@@ -158,5 +138,6 @@     QUERY,     SUBSCRIPTION,     ScalarValue (..),+    Value (..),   ) import Relude hiding (Undefined)

@@ -13,6 +13,7 @@     Describe (..),     Rename (..),     DropNamespace (..),+    DefaultValue (..),   ) where @@ -28,9 +29,7 @@     VisitField (..),     VisitType (..),   )-import Data.Morpheus.Types.Internal.AST-  ( DirectiveLocation (..),-  )+import Data.Morpheus.Types.Internal.AST (CONST, DirectiveLocation (..), Value) import Data.Text (drop, length, pack, unpack) import Relude hiding (drop, length) @@ -78,8 +77,6 @@          'ENUM_VALUE        ] --- description- newtype Describe = Describe {text :: Text}   deriving     ( GQLType,@@ -167,3 +164,18 @@ instance VisitType DropNamespace where   visitFieldNames DropNamespace {dropNamespace} = pack . stripFieldNamespace dropNamespace . unpack   visitEnumNames DropNamespace {dropNamespace} = pack . stripConstructorNamespace dropNamespace . unpack++newtype DefaultValue = DefaultValue+  { defaultValue :: Value CONST+  }+  deriving+    ( Generic,+      GQLType+    )++instance GQLDirective DefaultValue where+  type DIRECTIVE_LOCATIONS DefaultValue = '[ 'INPUT_FIELD_DEFINITION]+  excludeFromSchema _ = True++instance VisitField DefaultValue where+  visitFieldDefaultValue DefaultValue {defaultValue} _ = Just defaultValue

@@ -17,26 +17,29 @@     ToLocations (..),     getLocations,     -- visitors-    visitTypeName',-    visitTypeDescription',-    visitFieldName',-    visitFieldDescription',-    visitEnumName',     visitEnumDescription',-    visitFieldNames',+    visitEnumName',     visitEnumNames',+    visitFieldDefaultValue',+    visitFieldDescription',+    visitFieldName',+    visitFieldNames',+    visitTypeDescription',+    visitTypeName',   ) where  import Data.Morpheus.Server.Types.TypeName (getTypename) import qualified Data.Morpheus.Server.Types.Visitors as Visitors import Data.Morpheus.Types.Internal.AST-  ( Description,+  ( CONST,+    Description,     DirectiveLocation (..),     FALSE,     FieldName,     TRUE,     TypeName,+    Value,     packName,     unpackName,   )@@ -171,17 +174,23 @@ visitFieldDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description visitFieldDescription' = __visitFieldDescription (Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND)) +visitFieldDefaultValue' :: forall a. GQLDirective a => a -> Maybe (Value CONST) -> Maybe (Value CONST)+visitFieldDefaultValue' = __visitFieldDefaultValue (Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND))+ class VISIT_FIELD a (t :: Bool) where   __visitFieldName :: f t -> a -> FieldName -> FieldName   __visitFieldDescription :: f t -> a -> Maybe Description -> Maybe Description+  __visitFieldDefaultValue :: f t -> a -> Maybe (Value CONST) -> Maybe (Value CONST)  instance VISIT_FIELD a FALSE where   __visitFieldName _ _ = id   __visitFieldDescription _ _ = id+  __visitFieldDefaultValue _ _ = id  instance Visitors.VisitField a => VISIT_FIELD a TRUE where   __visitFieldName _ x name = packName $ Visitors.visitFieldName x (unpackName name)   __visitFieldDescription _ = Visitors.visitFieldDescription+  __visitFieldDefaultValue _ = Visitors.visitFieldDefaultValue  -- VISIT_ENUM 

@@ -19,16 +19,7 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Server.Types.GQLType-  ( GQLType-      ( KIND,-        description,-        getDescriptions,-        typeOptions,-        getDirectives,-        defaultValues,-        directives,-        __type-      ),+  ( GQLType (KIND, directives, __type),     __typeData,     deriveTypename,     deriveFingerprint,@@ -47,6 +38,7 @@     applyEnumDescription,     applyFieldName,     applyFieldDescription,+    applyFieldDefaultValue,     applyTypeFieldNames,     applyTypeEnumNames,     __isEmptyType,@@ -71,10 +63,11 @@ import Data.Morpheus.Server.NamedResolvers (NamedResolverT (..)) import Data.Morpheus.Server.Types.Directives   ( GQLDirective (..),-    ToLocations,+    ToLocations (..),     visitEnumDescription',     visitEnumName',     visitEnumNames',+    visitFieldDefaultValue',     visitFieldDescription',     visitFieldName',     visitFieldNames',@@ -82,9 +75,7 @@     visitTypeName',   ) import Data.Morpheus.Server.Types.Internal-  ( GQLTypeOptions (..),-    TypeData (..),-    defaultTypeOptions,+  ( TypeData (..),     mkTypeData,   ) import Data.Morpheus.Server.Types.Kind@@ -114,8 +105,8 @@     CONST,     Description,     DirectiveLocation (..),-    Directives,     FieldName,+    GQLError,     IN,     OUT,     ObjectEntry (..),@@ -129,13 +120,8 @@     packName,     toNullable,     unitTypeName,-    unpackName,   ) import Data.Sequence (Seq)-import Data.Text-  ( pack,-    unpack,-  ) import Data.Vector (Vector) import GHC.Generics import qualified Language.Haskell.TH.Syntax as TH@@ -161,19 +147,14 @@   Typeable a =>   f a ->   DirectiveUsages ->-  (Bool -> String -> String) ->   TypeCategory ->   TypeData-deriveTypeData proxy DirectiveUsages {typeDirectives} typeNameModifier cat =+deriveTypeData proxy DirectiveUsages {typeDirectives} cat =   TypeData-    { gqlTypeName = modifyName . packName . pack $ typeNameModifier isInput originalTypeName,+    { gqlTypeName = typeNameWithDirectives (cat == IN) (getTypename proxy) typeDirectives,       gqlWrappers = mkBaseType,       gqlFingerprint = getFingerprint cat proxy     }-  where-    isInput = cat == IN-    originalTypeName = unpack . unpackName $ getTypename proxy-    modifyName name = typeNameWithDirectives isInput name typeDirectives  list :: TypeWrapper -> TypeWrapper list = flip TypeList True@@ -193,49 +174,18 @@ --       ... deriving (Generic) -- --     instance GQLType ... where---       description = const "your description ..."+--        directives _ = typeDirective (Describe "some text") --  @-{-# DEPRECATED getDirectives "use: directives" #-}--{-# DEPRECATED description "use: directive Describe { text } with typeDirective" #-}--{-# DEPRECATED getDescriptions "use: directive Describe { text } with fieldDirective" #-}--{-# DEPRECATED typeOptions "use: custom directives with 'VisitType'" #-}- class GQLType a where   type KIND a :: DerivingKind   type KIND a = TYPE -  -- | A description of the type.-  ---  -- Used for documentation in the GraphQL schema.-  description :: f a -> Maybe Text-  description _ = Nothing-   directives :: f a -> DirectiveUsages   directives _ = mempty -  -- | A dictionary of descriptions for fields, keyed on field name.-  ---  -- Used for documentation in the GraphQL schema.-  getDescriptions :: f a -> Map Text Description-  getDescriptions _ = mempty--  typeOptions :: f a -> GQLTypeOptions -> GQLTypeOptions-  typeOptions _ = id--  getDirectives :: f a -> Map Text (Directives CONST)-  getDirectives _ = mempty--  defaultValues :: f a -> Map Text (Value CONST)-  defaultValues _ = mempty-   __type :: f a -> TypeCategory -> TypeData   default __type :: Typeable a => f a -> TypeCategory -> TypeData-  __type proxy = deriveTypeData proxy (directives proxy) typeNameModifier-    where-      GQLTypeOptions {typeNameModifier} = typeOptions proxy defaultTypeOptions+  __type proxy = deriveTypeData proxy (directives proxy)  instance GQLType Int where   type KIND Int = SCALAR@@ -261,6 +211,10 @@   type KIND ID = SCALAR   __type _ = mkTypeData "ID" +instance GQLType (Value CONST) where+  type KIND (Value CONST) = CUSTOM+  __type _ = mkTypeData "INTERNAL_VALUE"+ -- WRAPPERS instance GQLType () where   __type _ = mkTypeData unitTypeName@@ -336,11 +290,12 @@  type Decode a = EncodeKind (KIND a) a -encodeArguments :: forall a. Decode a => a -> GQLResult (Arguments CONST)-encodeArguments x = encode x >>= unpackValue+encodeArguments :: forall m a. (MonadError GQLError m, Decode a) => a -> m (Arguments CONST)+encodeArguments x = resultOr (const $ throwError err) pure (encode x) >>= unpackValue   where+    err = internal "could not encode arguments!"     unpackValue (Object v) = pure $ fmap toArgument v-    unpackValue _ = throwError (internal "TODO: expected arguments!")+    unpackValue _ = throwError err     toArgument ObjectEntry {..} = Argument (Position 0 0) entryName entryValue  encode :: forall a. Decode a => a -> GQLResult (Value CONST)@@ -358,6 +313,9 @@ instance (EncodeConstraint a) => EncodeKind TYPE a where   encodeKind = exploreResolvers . unContextValue +instance EncodeKind CUSTOM (Value CONST) where+  encodeKind = pure . unContextValue+ convertNode ::   DataType (GQLResult (Value CONST)) ->   GQLResult (Value CONST)@@ -376,7 +334,7 @@             entryValue <- fieldValue             pure ObjectEntry {entryName = fieldSelector, entryValue}       -- Type References ---------------------------------------------------------------      encodeTypeFields _ = throwError (internal "TODO: union not supported")+      encodeTypeFields _ = throwError (internal "input unions are not supported")  -- Types & Constrains ------------------------------------------------------- class (EncodeKind (KIND a) a, GQLType a) => ExplorerConstraint a@@ -466,20 +424,22 @@ applyEnumName :: DirectiveUsage -> TypeName -> TypeName applyEnumName (DirectiveUsage x) = visitEnumName' x +applyFieldName :: DirectiveUsage -> FieldName -> FieldName+applyFieldName (DirectiveUsage x) = visitFieldName' x+ applyFieldDescription :: DirectiveUsage -> Maybe Description -> Maybe Description applyFieldDescription (DirectiveUsage x) = visitFieldDescription' x -applyFieldName :: DirectiveUsage -> FieldName -> FieldName-applyFieldName (DirectiveUsage x) = visitFieldName' x+applyFieldDefaultValue :: DirectiveUsage -> Maybe (Value CONST) -> Maybe (Value CONST)+applyFieldDefaultValue (DirectiveUsage x) = visitFieldDefaultValue' x  applyTypeDescription :: DirectiveUsage -> Maybe Description -> Maybe Description applyTypeDescription (DirectiveUsage x) = visitTypeDescription' x  newtype InputTypeNamespace = InputTypeNamespace {inputTypeNamespace :: Text}-  deriving-    ( Generic,-      GQLType-    )+  deriving (Generic)+  deriving anyclass+    (GQLType)  instance GQLDirective InputTypeNamespace where   excludeFromSchema _ = True

@@ -1,13 +1,8 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Server.Types.Internal-  ( GQLTypeOptions (..),-    defaultTypeOptions,-    TypeData (..),-    prefixInputs,+  ( TypeData (..),     mkTypeData,-    dropNamespaceOptions,     stripConstructorNamespace,     stripFieldNamespace,   )@@ -18,8 +13,7 @@ import Data.Char (toLower) import Data.Morpheus.Server.Types.TypeName (TypeFingerprint (..)) import Data.Morpheus.Types.Internal.AST-  ( TypeKind (..),-    TypeName,+  ( TypeName,     TypeWrapper (..),     mkBaseType,   )@@ -33,48 +27,6 @@   }   deriving (Show) -{-# DEPRECATED GQLTypeOptions "use: custom directives with 'VisitType'" #-}---- | Options that specify how to map GraphQL field, type, and constructor names--- to and from their Haskell equivalent.------ Options can be set using record syntax on 'defaultOptions' with the fields--- below.-data GQLTypeOptions = GQLTypeOptions-  { -- | Function applied to field labels.-    -- Handy for removing common record prefixes for example.-    fieldLabelModifier :: String -> String,-    -- | Function applied to constructor tags.-    constructorTagModifier :: String -> String,-    -- | Construct a new type name depending on whether it is an input,-    -- and being given the original type name.-    typeNameModifier :: Bool -> String -> String-  }--{-# DEPRECATED defaultTypeOptions "use: custom directives with 'VisitType'" #-}---- | Default encoding 'GQLTypeOptions':------ @--- 'GQLTypeOptions'---   { 'fieldLabelModifier'      = id---   , 'constructorTagModifier'  = id---   , 'typeNameModifier'        = const id---   }--- @-defaultTypeOptions :: GQLTypeOptions-defaultTypeOptions =-  GQLTypeOptions-    { fieldLabelModifier = id,-      constructorTagModifier = id,-      -- default is just a pass through for the original type name-      typeNameModifier = const id-    }--{-# DEPRECATED prefixInputs "use: custom directives" #-}-prefixInputs :: GQLTypeOptions -> GQLTypeOptions-prefixInputs options = options {typeNameModifier = \isInput name -> if isInput then "Input" <> name else name}- mkTypeData :: TypeName -> a -> TypeData mkTypeData name _ =   TypeData@@ -94,13 +46,3 @@   where     __uncapitalize [] = []     __uncapitalize (x : xs) = toLower x : xs--{-# DEPRECATED dropNamespaceOptions "use: custom directives" #-}-dropNamespaceOptions :: TypeKind -> Text -> GQLTypeOptions -> GQLTypeOptions-dropNamespaceOptions KindInterface tName opt =-  opt-    { typeNameModifier = const (stripConstructorNamespace "Interface"),-      fieldLabelModifier = stripFieldNamespace tName-    }-dropNamespaceOptions KindEnum tName opt = opt {constructorTagModifier = stripConstructorNamespace tName}-dropNamespaceOptions _ tName opt = opt {fieldLabelModifier = stripFieldNamespace tName}

@@ -208,7 +208,6 @@ extendImplements :: TypeName -> [TypeName] -> SchemaT cat' () extendImplements interface types = SchemaT $ pure ((), [upLib])   where-    -- TODO: what happens if interface name collides?     upLib :: SchemaState -> GQLResult SchemaState     upLib schema = pure schema {implements = foldr insertInterface (implements schema) types}     insertInterface :: TypeName -> Map TypeName [TypeName] -> Map TypeName [TypeName]

@@ -16,6 +16,7 @@   ) where +import Data.Morpheus.Types.Internal.AST (CONST, Value) import Relude  class VisitType a where@@ -43,6 +44,9 @@    visitFieldDescription :: a -> Maybe Text -> Maybe Text   visitFieldDescription _ = id++  visitFieldDefaultValue :: a -> Maybe (Value CONST) -> Maybe (Value CONST)+  visitFieldDefaultValue _ = id  class VisitEnum a where   visitEnumName :: a -> Text -> Text