morpheus-graphql-app 0.26.0 → 0.27.0

raw patch · 10 files changed

+53/−35 lines, 10 filesdep ~morpheus-graphql-coredep ~morpheus-graphql-testsPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• morpheus-graphql-app.cabal +4/−4
• src/Data/Morpheus/App.hs +4/−4
• src/Data/Morpheus/App/Internal/Resolving/Batching.hs +17/−10
• src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs +1/−0
• src/Data/Morpheus/App/Internal/Resolving/RootResolverValue.hs +4/−4
• src/Data/Morpheus/App/Internal/Resolving/Types.hs +2/−0
• src/Data/Morpheus/App/Internal/Resolving/Utils.hs +5/−4
• src/Data/Morpheus/App/Internal/Stitching.hs +4/−0
• src/Data/Morpheus/App/RenderIntrospection.hs +9/−9
• src/Data/Morpheus/Types/GQLWrapper.hs +3/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morpheus-graphql-app-version:        0.26.0+version:        0.27.0 synopsis:       Morpheus GraphQL App description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -150,7 +150,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.26.0 && <0.27.0+    , morpheus-graphql-core >=0.27.0 && <0.28.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0@@ -182,8 +182,8 @@     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0     , morpheus-graphql-app-    , morpheus-graphql-core >=0.26.0 && <0.27.0-    , morpheus-graphql-tests >=0.26.0 && <0.27.0+    , morpheus-graphql-core >=0.27.0 && <0.28.0+    , morpheus-graphql-tests >=0.27.0 && <0.28.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0

@@ -63,7 +63,7 @@   ( GQLError,     GQLErrors,     Operation (..),-    OperationType (Mutation, Query, Subscription),+    OperationType (..),     Schema (..),     Selection (..),     SelectionContent (..),@@ -172,9 +172,9 @@         )  rootType :: OperationType -> Schema s -> Maybe (AST.TypeDefinition AST.OBJECT s)-rootType Query = Just . AST.query-rootType Mutation = mutation-rootType Subscription = subscription+rootType OPERATION_QUERY = Just . AST.query+rootType OPERATION_MUTATION = mutation+rootType OPERATION_SUBSCRIPTION = subscription  stateless ::   Functor m =>

@@ -30,8 +30,10 @@ import Control.Monad.Except (MonadError (throwError)) import Data.ByteString.Lazy.Char8 (unpack) import qualified Data.HashMap.Lazy as HM-import Data.Morpheus.App.Internal.Resolving.Types (NamedResolverRef (..), ResolverMap)-import Data.Morpheus.Core (RenderGQL, render)+import Data.Morpheus.App.Internal.Resolving.ResolverState (config)+import Data.Morpheus.App.Internal.Resolving.Types (ResolverMap)+import Data.Morpheus.App.Internal.Resolving.Utils+import Data.Morpheus.Core (Config (..), RenderGQL, render) import Data.Morpheus.Types.Internal.AST   ( GQLError,     Msg (..),@@ -41,8 +43,9 @@     ValidValue,     internal,   )+import Debug.Trace (trace) import GHC.Show (Show (show))-import Relude hiding (show)+import Relude hiding (show, trace)  type LocalCache = HashMap CacheKey ValidValue @@ -51,10 +54,13 @@   Just x -> pure x   Nothing -> throwError (internal $ "cache value could not found for key" <> msg (show v :: String)) -dumpCache :: Bool -> LocalCache -> a -> a-dumpCache enabled xs a-  | null xs || not enabled = a-  | otherwise = trace ("\nCACHE:\n" <> intercalate "\n" (map printKeyValue $ HM.toList xs) <> "\n") a+dumpCache :: Bool -> LocalCache -> LocalCache+dumpCache enabled cache+  | null cache || not enabled = cache+  | otherwise = trace ("\nCACHE:\n" <> printCache cache) cache++printCache :: LocalCache -> [Char]+printCache cache = intercalate "\n" (map printKeyValue $ HM.toList cache) <> "\n"   where     printKeyValue (key, v) = " " <> show key <> ": " <> unpack (render v) @@ -111,13 +117,14 @@   let entries = zip keys res   pure $ HM.fromList entries -updateCache :: (Monad m, Traversable t) => ResolverFun m -> LocalCache -> t BatchEntry -> m LocalCache+updateCache :: (ResolverMonad m, Traversable t) => ResolverFun m -> LocalCache -> t BatchEntry -> m LocalCache updateCache f cache entries = do   caches <- traverse (resolveBatched f) entries   let newCache = foldr (<>) cache caches-  pure $ dumpCache False newCache newCache+  enabled <- asks (debug . config)+  pure $ dumpCache enabled newCache -buildCacheWith :: Monad m => ResolverFun m -> LocalCache -> [(SelectionContent VALID, NamedResolverRef)] -> m LocalCache+buildCacheWith :: ResolverMonad m => ResolverFun m -> LocalCache -> [(SelectionContent VALID, NamedResolverRef)] -> m LocalCache buildCacheWith f cache entries = updateCache f cache (buildBatches entries)  data ResolverMapContext m = ResolverMapContext

@@ -209,6 +209,7 @@ processResult _ selection (NamedUnionResolver unionRef) = resolveSelection (ResRef $ pure unionRef) selection processResult _ selection (NamedEnumResolver value) = resolveSelection (ResEnum value) selection processResult _ selection NamedNullResolver = resolveSelection ResNull selection+processResult _ selection (NamedScalarResolver v) = resolveSelection (ResScalar v) selection  resolveUncached ::   ( MonadError GQLError m,

@@ -105,18 +105,18 @@   ctx@ResolverContext {operation = Operation {operationType, operationSelection}} =     selectByOperation operationType     where-      selectByOperation Query =+      selectByOperation OPERATION_QUERY =         withIntrospection (runRootDataResolver channelMap queryResolver ctx) ctx-      selectByOperation Mutation =+      selectByOperation OPERATION_MUTATION =         runRootDataResolver channelMap mutationResolver ctx operationSelection-      selectByOperation Subscription =+      selectByOperation OPERATION_SUBSCRIPTION =         runRootDataResolver channelMap subscriptionResolver ctx operationSelection runRootResolverValue   NamedResolversValue {queryResolverMap}   ctx@ResolverContext {operation = Operation {operationType}} =     selectByOperation operationType     where-      selectByOperation Query = withIntrospection (\sel -> runResolver Nothing (resolvedValue sel) ctx) ctx+      selectByOperation OPERATION_QUERY = withIntrospection (\sel -> runResolver Nothing (resolvedValue sel) ctx) ctx         where           resolvedValue selection = resolveRef (ResolverMapContext empty queryResolverMap) (NamedResolverRef "Query" ["ROOT"]) (SelectionSet selection)       selectByOperation _ = throwError "mutation and subscription is not supported for namedResolvers"

@@ -81,6 +81,7 @@   = NamedObjectResolver (ObjectTypeResolver m)   | NamedUnionResolver NamedResolverRef   | NamedEnumResolver TypeName+  | NamedScalarResolver ScalarValue   | NamedNullResolver  instance KeyOf TypeName (NamedResolver m) where@@ -91,6 +92,7 @@   show NamedUnionResolver {} = "NamedUnionResolver"   show NamedEnumResolver {} = "NamedEnumResolver"   show NamedNullResolver {} = "NamedNullResolver"+  show NamedScalarResolver {} = "NamedScalarResolver"  data ResolverValue (m :: Type -> Type)   = ResNull

@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -16,6 +17,7 @@     ObjectTypeResolver,     lookupResJSON,     mkValue,+    ResolverMonad,   ) where @@ -49,11 +51,10 @@ import qualified Data.Vector as V import Relude hiding (break) +type ResolverMonad m = (MonadError GQLError m, MonadReader ResolverContext m)+ lookupResJSON ::-  ( MonadError GQLError f,-    MonadReader ResolverContext f,-    MonadReader ResolverContext m-  ) =>+  (ResolverMonad f, MonadReader ResolverContext m) =>   FieldName ->   A.Value ->   f (ObjectTypeResolver m)

@@ -111,6 +111,7 @@       <*> prop stitch typeContent x y  instance Stitching (TypeContent TRUE cat s) where+  stitch (DataScalar _) (DataScalar x) = pure $ DataScalar x   stitch (DataObject i1 fields1) (DataObject i2 fields2) =     DataObject (i1 <> i2) <$> stitch fields1 fields2   stitch x y@@ -140,9 +141,12 @@   stitch t1 t2 = pure $ R.ObjectTypeResolver (R.objectFields t1 <> R.objectFields t2)  instance (MonadError GQLError m) => Stitching (NamedResolverResult m) where+  -- TODO: app level constraint ensures that they have same re4solver function+  stitch NamedScalarResolver {} (NamedScalarResolver f) = pure (NamedScalarResolver f)   stitch NamedEnumResolver {} (NamedEnumResolver x) = pure (NamedEnumResolver x)   stitch NamedUnionResolver {} (NamedUnionResolver x) = pure (NamedUnionResolver x)   stitch (NamedObjectResolver t1) (NamedObjectResolver t2) = NamedObjectResolver <$> stitch t1 t2+  -- NUll   stitch NamedNullResolver x = pure x   stitch x NamedNullResolver = pure x   stitch _ _ = throwError "ResolverMap must have same Kind"

@@ -163,21 +163,21 @@           ) =>           TypeContent bool a VALID ->           ResolverValue m-        renderContent DataScalar {} = __type KindScalar []-        renderContent (DataEnum enums) = __type KindEnum [("enumValues", render enums)]+        renderContent DataScalar {} = __type KIND_SCALAR []+        renderContent (DataEnum enums) = __type KIND_ENUM [("enumValues", render enums)]         renderContent (DataInputObject inputFields) =           __type-            KindInputObject+            KIND_INPUT_OBJECT             [("inputFields", render inputFields)]         renderContent DataObject {objectImplements, objectFields} =           createObjectType typeName typeDescription objectImplements objectFields         renderContent (DataUnion union) =           __type-            KindUnion+            KIND_UNION             [("possibleTypes", render $ toList union)]         renderContent (DataInputUnion members) =           mkType-            KindInputObject+            KIND_INPUT_OBJECT             typeName             ( Just                 ( "Note! This input is an exclusive object,\n"@@ -191,7 +191,7 @@             ]         renderContent (DataInterface fields) =           __type-            KindInterface+            KIND_INTERFACE             [ ("fields", render fields),               ("possibleTypes", renderPossibleTypes typeName)             ]@@ -261,7 +261,7 @@           withNonNull isNonNull $             mkObject               "__Type"-              [ renderKind KindList,+              [ renderKind KIND_LIST,                 ("ofType", renderWrapper nextWrapper)               ]       renderWrapper (BaseType isNonNull) =@@ -279,7 +279,7 @@ withNonNull True contentType =   mkObject     "__Type"-    [ renderKind KindNonNull,+    [ renderKind KIND_NON_NULL,       ("ofType", pure contentType)     ] withNonNull False contentType = contentType@@ -341,7 +341,7 @@   FieldsDefinition OUT VALID ->   ResolverValue m createObjectType name desc interfaces fields =-  mkType (KindObject Nothing) name desc [("fields", render fields), ("interfaces", mkList <$> traverse implementedInterface interfaces)]+  mkType (KIND_OBJECT Nothing) name desc [("fields", render fields), ("interfaces", mkList <$> traverse implementedInterface interfaces)]  implementedInterface ::   (Monad m, WithSchema m) =>

@@ -140,3 +140,6 @@  instance EncodeWrapperValue Maybe where   encodeWrapperValue = maybe (pure Null)++instance EncodeWrapperValue [] where+  encodeWrapperValue f xs = List <$> traverse f xs