diff --git a/morpheus-graphql-app.cabal b/morpheus-graphql-app.cabal --- a/morpheus-graphql-app.cabal +++ b/morpheus-graphql-app.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: morpheus-graphql-app -version: 0.20.1 +version: 0.21.0 synopsis: Morpheus GraphQL App description: Build GraphQL APIs with your favourite functional language! category: web, graphql @@ -123,7 +123,7 @@ , containers >=0.4.2.1 && <0.7.0 , hashable >=1.0.0 && <2.0.0 , megaparsec >=7.0.0 && <10.0.0 - , morpheus-graphql-core >=0.20.0 && <0.21.0 + , morpheus-graphql-core >=0.21.0 && <0.22.0 , mtl >=2.0.0 && <3.0.0 , relude >=0.3.0 && <2.0.0 , scientific >=0.3.6.2 && <0.4.0 @@ -153,8 +153,8 @@ , hashable >=1.0.0 && <2.0.0 , megaparsec >=7.0.0 && <10.0.0 , morpheus-graphql-app - , morpheus-graphql-core >=0.20.0 && <0.21.0 - , morpheus-graphql-tests >=0.20.0 && <0.21.0 + , morpheus-graphql-core >=0.21.0 && <0.22.0 + , morpheus-graphql-tests >=0.21.0 && <0.22.0 , mtl >=2.0.0 && <3.0.0 , relude >=0.3.0 && <2.0.0 , scientific >=0.3.6.2 && <0.4.0 diff --git a/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs b/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs --- a/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs @@ -28,10 +28,9 @@ mkUnion, ) import Data.Morpheus.Error (subfieldsNotSelected) -import Data.Morpheus.Internal.Utils ((<:>), KeyOf (keyOf), selectOr, traverseCollection) +import Data.Morpheus.Internal.Utils (KeyOf (keyOf), selectOr, traverseCollection, (<:>)) import Data.Morpheus.Types.Internal.AST ( GQLError, - GQLError, Msg (msg), ObjectEntry (ObjectEntry), ScalarValue (..), @@ -42,9 +41,7 @@ TypeName, UnionTag (unionTagSelection), VALID, - VALID, ValidValue, - ValidValue, Value (..), internal, unitFieldName, @@ -137,9 +134,10 @@ where resolver currentSelection = do t <- askFieldTypeName (selectionName currentSelection) - updateCurrentType t $ local (\ctx -> ctx {currentSelection}) $ - ObjectEntry (keyOf currentSelection) - <$> runFieldResolver rmap currentSelection drv + updateCurrentType t $ + local (\ctx -> ctx {currentSelection}) $ + ObjectEntry (keyOf currentSelection) + <$> runFieldResolver rmap currentSelection drv runFieldResolver :: ( Monad m, @@ -152,8 +150,8 @@ m ValidValue runFieldResolver rmap Selection {selectionName, selectionContent} | selectionName == "__typename" = - const (Scalar . String . unpackName <$> asks (typeName . currentType)) + const (Scalar . String . unpackName <$> asks (typeName . currentType)) | otherwise = - maybe (pure Null) (>>= \x -> resolveSelection rmap x selectionContent) - . HM.lookup selectionName - . objectFields + maybe (pure Null) (>>= \x -> resolveSelection rmap x selectionContent) + . HM.lookup selectionName + . objectFields diff --git a/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs b/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs --- a/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs @@ -199,9 +199,9 @@ Resolver QUERY e m (e -> Resolver SUBSCRIPTION e m a) -> SubscriptionField (Resolver SUBSCRIPTION e m a) subscribe ch res = - SubscriptionField ch - $ ResolverS - $ fromSub <$> runResolverQ res + SubscriptionField ch $ + ResolverS $ + fromSub <$> runResolverQ res where fromSub :: Monad m => (e -> Resolver SUBSCRIPTION e m a) -> ReaderT e (ResolverStateT () m) a fromSub f = join (ReaderT (runResolverS . f)) diff --git a/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs b/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs --- a/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs @@ -141,10 +141,10 @@ throwError err = do ctx <- asks id let f = if isInternal err then renderInternalResolverError ctx else resolverFailureMessage ctx - ResolverStateT - $ lift - $ throwError - $ f err + ResolverStateT $ + lift $ + throwError $ + f err catchError (ResolverStateT mx) f = ResolverStateT $ catchError mx (_runResolverStateT . f) instance (Monad m) => PushEvents e (ResolverStateT e m) where @@ -187,7 +187,8 @@ <> msg selectionName <> ": " <> err - <> withInternalContext ctx `at` selectionPosition + <> withInternalContext ctx + `at` selectionPosition renderInternalResolverError :: ResolverContext -> GQLError -> GQLError renderInternalResolverError ctx@ResolverContext {currentSelection} err = @@ -214,7 +215,10 @@ renderSection :: RenderGQL a => GQLError -> a -> GQLError renderSection label content = - "\n\n" <> label <> ":\n" <> line + "\n\n" + <> label + <> ":\n" + <> line <> "\n\n" <> msg (render content) <> "\n\n" diff --git a/src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs b/src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs --- a/src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs @@ -111,9 +111,9 @@ runRootResolverValue NamedResolversValue { queryResolverMap - -- mutationResolverMap, - -- subscriptionResolverMap, - --typeResolverChannels + -- mutationResolverMap, + -- subscriptionResolverMap, + -- typeResolverChannels } ctx@ResolverContext {operation = Operation {operationType}} = selectByOperation operationType diff --git a/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs b/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs --- a/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs @@ -28,6 +28,7 @@ ) import Data.Morpheus.Types.Internal.AST ( Argument (..), + DirectiveDefinition (..), FieldName, OBJECT, QUERY, @@ -72,7 +73,7 @@ ("queryType", renderOperation (Just query)), ("mutationType", renderOperation mutation), ("subscriptionType", renderOperation subscription), - ("directives", render $ toList directiveDefinitions) + ("directives", render $ sortWith directiveDefinitionName $ toList directiveDefinitions) ] schemaAPI :: Monad m => Schema VALID -> ObjectTypeResolver (Resolver QUERY e m) diff --git a/src/Data/Morpheus/App/Internal/Resolving/Utils.hs b/src/Data/Morpheus/App/Internal/Resolving/Utils.hs --- a/src/Data/Morpheus/App/Internal/Resolving/Utils.hs +++ b/src/Data/Morpheus/App/Internal/Resolving/Utils.hs @@ -29,8 +29,8 @@ mkNull, mkObjectMaybe, ) -import qualified Data.Morpheus.Internal.Utils as U import Data.Morpheus.Internal.Utils (selectOr, toAssoc) +import qualified Data.Morpheus.Internal.Utils as U import Data.Morpheus.Types.Internal.AST ( FieldName, GQLError, diff --git a/src/Data/Morpheus/App/Internal/Stitching.hs b/src/Data/Morpheus/App/Internal/Stitching.hs --- a/src/Data/Morpheus/App/Internal/Stitching.hs +++ b/src/Data/Morpheus/App/Internal/Stitching.hs @@ -142,14 +142,14 @@ instance (MonadError GQLError m) => Stitching (NamedResolver m) where stitch t1 t2 | resolverName t1 == resolverName t2 = - pure - NamedResolver - { resolverName = resolverName t1, - resolver = \arg -> do - t1' <- resolver t1 arg - t2' <- resolver t2 arg - stitch t1' t2' - } + pure + NamedResolver + { resolverName = resolverName t1, + resolver = \arg -> do + t1' <- resolver t1 arg + t2' <- resolver t2 arg + stitch t1' t2' + } | otherwise = throwError "ResolverMap must have same resolverName" instance Monad m => Stitching (RootResolverValue e m) where diff --git a/src/Data/Morpheus/App/RenderIntrospection.hs b/src/Data/Morpheus/App/RenderIntrospection.hs --- a/src/Data/Morpheus/App/RenderIntrospection.hs +++ b/src/Data/Morpheus/App/RenderIntrospection.hs @@ -218,14 +218,14 @@ (FieldDefinition OUT VALID) where render FieldDefinition {..} = - pure - $ mkObject "__Field" - $ [ renderName fieldName, + pure $ + mkObject "__Field" $ + [ renderName fieldName, description fieldDescription, type' fieldType, ("args", maybe (pure $ mkList []) render fieldContent) ] - <> renderDeprecated fieldDirectives + <> renderDeprecated fieldDirectives instance RenderIntrospection (FieldContent TRUE OUT VALID) where render (FieldArgs args) = render args @@ -246,25 +246,25 @@ instance RenderIntrospection (DataEnumValue VALID) where render DataEnumValue {enumName, enumDescription, enumDirectives} = - pure - $ mkObject "__Field" - $ [ renderName enumName, + pure $ + mkObject "__Field" $ + [ renderName enumName, description enumDescription ] - <> renderDeprecated enumDirectives + <> renderDeprecated enumDirectives instance RenderIntrospection TypeRef where render TypeRef {typeConName, typeWrappers} = renderWrapper typeWrappers where renderWrapper :: (Monad m, WithSchema m) => TypeWrapper -> m (ResolverValue m) renderWrapper (TypeList nextWrapper isNonNull) = - pure - $ withNonNull isNonNull - $ mkObject - "__Type" - [ renderKind KindList, - ("ofType", renderWrapper nextWrapper) - ] + pure $ + withNonNull isNonNull $ + mkObject + "__Type" + [ renderKind KindList, + ("ofType", renderWrapper nextWrapper) + ] renderWrapper (BaseType isNonNull) = withNonNull isNonNull <$> do kind <- kindOf <$> selectType typeConName diff --git a/src/Data/Morpheus/Types/GQLWrapper.hs b/src/Data/Morpheus/Types/GQLWrapper.hs --- a/src/Data/Morpheus/Types/GQLWrapper.hs +++ b/src/Data/Morpheus/Types/GQLWrapper.hs @@ -6,6 +6,7 @@ ( EncodeWrapper (..), DecodeWrapper (..), DecodeWrapperConstraint, + EncodeWrapperValue (..), ) where @@ -17,7 +18,8 @@ mkNull, ) import Data.Morpheus.Types.Internal.AST - ( GQLError, + ( CONST, + GQLError, ValidValue, Value (..), msg, @@ -128,5 +130,13 @@ -- if value is already validated but value has different type typeMismatch :: GQLError -> Value s -> GQLError typeMismatch text jsType = - "Type mismatch! expected:" <> msg text <> ", got: " + "Type mismatch! expected:" + <> msg text + <> ", got: " <> msg jsType + +class EncodeWrapperValue (f :: Type -> Type) where + encodeWrapperValue :: (Monad m) => (a -> m (Value CONST)) -> f a -> m (Value CONST) + +instance EncodeWrapperValue Maybe where + encodeWrapperValue = maybe (pure Null)