morpheus-graphql-client 0.26.0 → 0.27.0

raw patch · 7 files changed

+69/−56 lines, 7 filesdep ~morpheus-graphql-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: morpheus-graphql-core

API changes (from Hackage documentation)

Files

• morpheus-graphql-client.cabal +3/−3
• src/Data/Morpheus/Client/CodeGen/Declare.hs +4/−3
• src/Data/Morpheus/Client/CodeGen/Interpreting/Core.hs +15/−27
• src/Data/Morpheus/Client/CodeGen/Interpreting/Global.hs +13/−11
• src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs +29/−7
• src/Data/Morpheus/Client/Fetch/RequestType.hs +2/−2
• src/Data/Morpheus/Client/Schema/JSON/Parse.hs +3/−3

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morpheus-graphql-client-version:        0.26.0+version:        0.27.0 synopsis:       Morpheus GraphQL Client description:    Build GraphQL APIs with your favorite functional language! category:       web, graphql, client@@ -94,7 +94,7 @@     , file-embed >=0.0.10 && <1.0.0     , modern-uri >=0.1.0.0 && <1.0.0     , morpheus-graphql-code-gen-utils-    , morpheus-graphql-core >=0.26.0 && <0.27.0+    , morpheus-graphql-core >=0.27.0 && <0.28.0     , morpheus-graphql-subscriptions     , mtl >=2.0.0 && <3.0.0     , prettyprinter >=1.7.0 && <2.0.0@@ -137,7 +137,7 @@     , modern-uri >=0.1.0.0 && <1.0.0     , morpheus-graphql-client     , morpheus-graphql-code-gen-utils-    , morpheus-graphql-core >=0.26.0 && <0.27.0+    , morpheus-graphql-core >=0.27.0 && <0.28.0     , morpheus-graphql-subscriptions     , mtl >=2.0.0 && <3.0.0     , prettyprinter >=1.7.0 && <2.0.0

@@ -36,6 +36,7 @@ import Data.Morpheus.CodeGen.TH   ( PrintDec (printDec),   )+import Data.Morpheus.CodeGen.Utils import Data.Morpheus.Core (parseRequest) import Data.Morpheus.Internal.Ext (GQLResult) import Data.Morpheus.Types.IO (GQLRequest (..))@@ -57,9 +58,9 @@   clientTypeDeclarations schemaText (Just query)  globalTypeDeclarations :: SchemaSource -> (TypeName -> Bool) -> Q [Dec]-globalTypeDeclarations src f = handleResult (parseSchema src >>= toGlobalDefinitions f) printDeclarations+globalTypeDeclarations src f = handleResult (parseSchema src >>= fmap fst . toGlobalDefinitions f) printDeclarations -parseClientTypeDeclarations :: SchemaSource -> Maybe Text -> GQLResult [ClientDeclaration]+parseClientTypeDeclarations :: SchemaSource -> Maybe Text -> GQLResult ([ClientDeclaration], Flags) parseClientTypeDeclarations schemaText (Just query) = do   schemaDoc <- parseSchema schemaText   executableDoc <-@@ -78,7 +79,7 @@   SchemaSource ->   Maybe ExecutableSource ->   Q [Dec]-clientTypeDeclarations src x = handleResult (parseClientTypeDeclarations src x) printDeclarations+clientTypeDeclarations src x = handleResult (fmap fst (parseClientTypeDeclarations src x)) printDeclarations  {- ORMOLU_DISABLE -} -- | declares input, enum and scalar types for specified schema

@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}@@ -9,7 +8,7 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Client.CodeGen.Interpreting.Core-  ( LocalM (..),+  ( LocalM,     compileError,     getType,     typeFrom,@@ -18,7 +17,6 @@     defaultDerivations,     warning,     LocalContext (..),-    runLocalM,     withPosition,     getNameByPath,     registerFragment,@@ -26,6 +24,7 @@     removeDuplicates,     clientConfig,     lookupField,+    lookupType,   ) where @@ -41,10 +40,12 @@     TypeClassInstance (..),     fromTypeName,   )+import Data.Morpheus.CodeGen.Utils+  ( CodeGenT,+  ) import Data.Morpheus.Core (Config (..), VALIDATION_MODE (WITHOUT_VARIABLES)) import Data.Morpheus.Internal.Ext-  ( GQLResult,-    Result (..),+  ( Result (..),   ) import Data.Morpheus.Internal.Utils   ( empty,@@ -70,11 +71,11 @@     VALID,     VariableDefinitions,     internal,+    lookupDataType,     lookupDeprecated,     lookupDeprecatedReason,     mkTypeRef,     msg,-    typeDefinitions,   ) import Data.Set (insert, member) import Relude hiding (empty)@@ -107,34 +108,21 @@ existFragment :: FragmentName -> LocalM Bool existFragment name = (name `member`) <$> asks ctxFragments -runLocalM :: LocalContext -> LocalM a -> GQLResult a-runLocalM context = flip runReaderT context . _runLocalM- withPosition :: Position -> LocalM a -> LocalM a withPosition pos = local (\ctx -> ctx {ctxPosition = Just pos}) -newtype LocalM a = LocalM-  { _runLocalM ::-      ReaderT-        LocalContext-        GQLResult-        a-  }-  deriving-    ( Functor,-      Applicative,-      Monad,-      MonadReader LocalContext,-      MonadError GQLError-    )+type LocalM a = CodeGenT LocalContext (Result GQLError) a  compileError :: GQLError -> GQLError compileError x = internal $ "Unhandled Compile Time Error: \"" <> x <> "\" ;" +lookupType :: TypeName -> LocalM (Maybe (TypeDefinition ANY VALID))+lookupType name = asks (lookupDataType name . ctxSchema)+ getType :: TypeName -> LocalM (TypeDefinition ANY VALID)-getType typename =-  asks (typeDefinitions . ctxSchema)-    >>= selectBy (compileError $ " can't find Type" <> msg typename) typename+getType name = do+  x <- lookupType name+  maybe (throwError $ compileError $ " can't find Type" <> msg name) pure x  typeFrom :: [FieldName] -> TypeDefinition a VALID -> CodeGenTypeName typeFrom path TypeDefinition {typeName, typeContent} = __typeFrom typeContent@@ -153,7 +141,7 @@ deprecationWarning f = traverse_ warning . toList . fmap (f . lookupDeprecatedReason) . lookupDeprecated  warning :: GQLError -> LocalM ()-warning w = LocalM $ lift $ Success {result = (), warnings = [w]}+warning w = lift $ Success {result = (), warnings = [w]}  defaultDerivations :: [DerivingClass] defaultDerivations = [GENERIC, SHOW, CLASS_EQ]

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -27,6 +28,7 @@     FIELD_TYPE_WRAPPER (..),     fromTypeName,   )+import Data.Morpheus.CodeGen.Utils (Flag (FlagLanguageExtension), Flags) import Data.Morpheus.Internal.Ext (GQLResult) import Data.Morpheus.Types.Internal.AST   ( ANY,@@ -48,18 +50,18 @@  toClientDeclarations :: ClientTypeDefinition -> [ClientPreDeclaration] toClientDeclarations def@ClientTypeDefinition {clientKind}-  | KindScalar == clientKind = [FromJSONClass SCALAR_MODE cgType, ToJSONClass SCALAR_MODE cgType]-  | KindEnum == clientKind = [ClientType cgType, FromJSONClass ENUM_MODE cgType, ToJSONClass ENUM_MODE cgType]+  | KIND_SCALAR == clientKind = [FromJSONClass SCALAR_MODE cgType, ToJSONClass SCALAR_MODE cgType]+  | KIND_ENUM == clientKind = [ClientType cgType, FromJSONClass ENUM_MODE cgType, ToJSONClass ENUM_MODE cgType]   | otherwise = [ClientType cgType, ToJSONClass TYPE_MODE cgType]   where     cgType = printClientType def -toGlobalDefinitions :: (TypeName -> Bool) -> Schema VALID -> GQLResult [ClientDeclaration]-toGlobalDefinitions f Schema {types} =-  traverse mapPreDeclarations $-    concatMap toClientDeclarations $-      mapMaybe generateGlobalType $-        filter shouldInclude (sortWith typeName $ toList types)+toGlobalDefinitions :: (TypeName -> Bool) -> Schema VALID -> GQLResult ([ClientDeclaration], Flags)+toGlobalDefinitions f Schema {types} = do+  let tyDefs = mapMaybe generateGlobalType $ filter shouldInclude (sortWith typeName $ toList types)+  decs <- traverse mapPreDeclarations $ concatMap toClientDeclarations tyDefs+  let hasEnums = not $ null [x | x@ClientTypeDefinition {clientKind = KIND_ENUM} <- tyDefs]+  pure (decs, [FlagLanguageExtension "LambdaCase" | hasEnums])   where     shouldInclude t =       not (isResolverType t)@@ -79,15 +81,15 @@     genContent :: TypeContent TRUE ANY VALID -> Maybe (TypeKind, [CodeGenConstructor])     genContent (DataInputObject inputFields) =       pure-        ( KindInputObject,+        ( KIND_INPUT_OBJECT,           [ CodeGenConstructor               { constructorName = fromTypeName typeName,                 constructorFields = toCodeGenField <$> toList inputFields               }           ]         )-    genContent (DataEnum enumTags) = pure (KindEnum, mkConsEnum typeName <$> enumTags)-    genContent DataScalar {} = pure (KindScalar, [])+    genContent (DataEnum enumTags) = pure (KIND_ENUM, mkConsEnum typeName <$> enumTags)+    genContent DataScalar {} = pure (KIND_SCALAR, [])     genContent _ = Nothing  toCodeGenField :: FieldDefinition a b -> CodeGenField

@@ -21,7 +21,7 @@ import Data.Morpheus.Client.CodeGen.Interpreting.Arguments (genArguments) import Data.Morpheus.Client.CodeGen.Interpreting.Core   ( LocalContext (..),-    LocalM (..),+    LocalM,     clientConfig,     defaultDerivations,     deprecationWarning,@@ -29,16 +29,30 @@     getNameByPath,     getType,     lookupField,+    lookupType,     registerFragment,     removeDuplicates,-    runLocalM,     typeFrom,     warning,   ) import Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations   ( mapPreDeclarations,   )-import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenField (..), CodeGenType (..), CodeGenTypeName (..), FIELD_TYPE_WRAPPER (..), fromTypeName, getFullName)+import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenConstructor (..),+    CodeGenField (..),+    CodeGenType (..),+    CodeGenTypeName (..),+    FIELD_TYPE_WRAPPER (..),+    fromTypeName,+    getFullName,+  )+import Data.Morpheus.CodeGen.Utils+  ( Flags,+    langExtension,+    requireExternal,+    runCodeGenT,+  ) import Data.Morpheus.Core (validateRequest) import Data.Morpheus.Error (deprecatedField) import Data.Morpheus.Internal.Ext@@ -62,6 +76,7 @@     SelectionContent (..),     SelectionSet,     TypeDefinition (..),+    TypeKind (..),     TypeName,     TypeRef (..),     UnionTag (..),@@ -70,6 +85,7 @@     getOperationDataType,     getOperationName,     isNullable,+    kindOf,     msg,     toAny,     unpackName,@@ -79,7 +95,7 @@ import qualified Data.Text as T import Relude hiding (empty, show) -toLocalDefinitions :: (Text, ExecutableDocument) -> Schema VALID -> GQLResult [ClientDeclaration]+toLocalDefinitions :: (Text, ExecutableDocument) -> Schema VALID -> GQLResult ([ClientDeclaration], Flags) toLocalDefinitions (query, request) ctxSchema = do   validOperation <- validateRequest clientConfig ctxSchema request   let context =@@ -89,8 +105,9 @@             ctxPosition = Nothing,             ctxFragments = mempty           }-  x <- runLocalM context $ genLocalDeclarations query validOperation-  removeDuplicates <$> traverse mapPreDeclarations x+  (t, flags) <- runCodeGenT (genLocalDeclarations query validOperation) context+  types <- removeDuplicates <$> traverse mapPreDeclarations t+  pure (types, flags)  genLocalDeclarations :: Text -> Operation VALID -> LocalM [ClientPreDeclaration] genLocalDeclarations query op@Operation {operationName, operationSelection, operationType} = do@@ -124,7 +141,11 @@   TypeDefinition ANY VALID ->   Selection VALID ->   LocalM (CodeGenTypeName, [ClientPreDeclaration])-subTypesBySelection name _ _ Selection {selectionContent = SelectionField} = pure (fromTypeName name, [])+subTypesBySelection name _ _ Selection {selectionContent = SelectionField} = do+  kind <- fmap kindOf <$> lookupType name+  if null kind || kind == Just KIND_SCALAR+    then requireExternal (unpackName name) $> (fromTypeName name, [])+    else pure (fromTypeName name, []) subTypesBySelection _ path dType Selection {selectionContent = SelectionSet selectionSet} =   genLocalTypes path (getFullName $ typeFrom [] dType) dType selectionSet subTypesBySelection _ namespace dType Selection {selectionPosition, selectionContent = UnionSelection interface unionSelections} =@@ -135,6 +156,7 @@     (cons, subTypes) <- unzip <$> traverse (getVariant namespace) variants     (fallbackCons, fallBackTypes) <- maybe (getEmptyFallback cgTypeName) (getVariant namespace . UnionTag (typeName dType)) interface     let typeDef = CodeGenType {cgTypeName, cgConstructors = map buildVariantConstructor (cons <> [fallbackCons]), cgDerivations = defaultDerivations}+    langExtension "LambdaCase"     pure (cgTypeName, [ClientType typeDef, FromJSONUnionClass cgTypeName (map tagConstructor cons <> [(UVar "_fallback", mapFallback fallbackCons)])] <> concat subTypes <> fallBackTypes)   where     tagConstructor (name, x) = (UString $ typename name, (name, fmap (const "v") x))

@@ -40,7 +40,7 @@   ) import Data.Morpheus.Types.Internal.AST   ( FieldName,-    OperationType (Subscription),+    OperationType (..),   ) import Data.Text   ( pack,@@ -80,4 +80,4 @@ newtype Request (a :: Type) = Request {requestArgs :: RequestArgs a}  isSubscription :: RequestType a => Request a -> Bool-isSubscription x = __type x == Subscription+isSubscription x = __type x == OPERATION_SUBSCRIPTION

@@ -113,9 +113,9 @@     SchemaDefinition empty       <$> fromElems         ( catMaybes-            [ Just (RootOperationTypeDefinition Query $ Ref.name queryType),-              RootOperationTypeDefinition Mutation . Ref.name <$> mutationType,-              RootOperationTypeDefinition Subscription . Ref.name <$> subscriptionType+            [ Just (RootOperationTypeDefinition OPERATION_QUERY $ Ref.name queryType),+              RootOperationTypeDefinition OPERATION_MUTATION . Ref.name <$> mutationType,+              RootOperationTypeDefinition OPERATION_SUBSCRIPTION . Ref.name <$> subscriptionType             ]         )