packages feed

morpheus-graphql-client 0.17.0 → 0.18.0

raw patch · 38 files changed

+663/−206 lines, 38 filesdep +morpheus-graphql-code-gendep ~morpheus-graphql-corePVP ok

version bump matches the API change (PVP)

Dependencies added: morpheus-graphql-code-gen

Dependency ranges changed: morpheus-graphql-core

API changes (from Hackage documentation)

+ Data.Morpheus.Client: FetchErrorNoResult :: FetchError a
+ Data.Morpheus.Client: FetchErrorParseFailure :: String -> FetchError a
+ Data.Morpheus.Client: FetchErrorProducedErrors :: GQLErrors -> Maybe a -> FetchError a
+ Data.Morpheus.Client: data FetchError a
+ Data.Morpheus.Client: defineByDocumentFile' :: Q FilePath -> (ExecutableDocument, String) -> Q [Dec]
+ Data.Morpheus.Client: defineByIntrospectionFile' :: Q FilePath -> (ExecutableDocument, String) -> Q [Dec]
- Data.Morpheus.Client: __fetch :: (Fetch a, Monad m, Show a, ToJSON (Args a), FromJSON a) => String -> FieldName -> (ByteString -> m ByteString) -> Args a -> m (Either String a)
+ Data.Morpheus.Client: __fetch :: (Fetch a, Monad m, Show a, ToJSON (Args a), FromJSON a) => String -> FieldName -> (ByteString -> m ByteString) -> Args a -> m (Either (FetchError a) a)
- Data.Morpheus.Client: defineQuery :: IO (Eventless (Schema VALID)) -> (ExecutableDocument, String) -> Q [Dec]
+ Data.Morpheus.Client: defineQuery :: IO (GQLResult (Schema VALID)) -> (ExecutableDocument, String) -> Q [Dec]
- Data.Morpheus.Client: fetch :: (Fetch a, Monad m, FromJSON a) => (ByteString -> m ByteString) -> Args a -> m (Either String a)
+ Data.Morpheus.Client: fetch :: (Fetch a, Monad m, FromJSON a) => (ByteString -> m ByteString) -> Args a -> m (Either (FetchError a) a)

Files

changelog.md view
@@ -1,5 +1,17 @@ # Changelog +## 0.18.0 - 08.11.2021++### Minor Changes++- added `morpheus-graphql-code-gen` to dependency+- Add defineBy\*File' variants that take a `Q FilePath` [#584](https://github.com/morpheusgraphql/morpheus-graphql/pull/584)++- fixed: Generation of data constructors for non-capitalized enums+- fixed invalid scalar type generation and added tests to ensure their validity for each upcoming version [#583](https://github.com/morpheusgraphql/morpheus-graphql/issues/583)++- return all response errors gracefully as a Left when fetching [#577](https://github.com/morpheusgraphql/morpheus-graphql/issues/577) - Thanks @AlistairB+ ## 0.17.0 - 25.02.2021  ### Breaking changes
morpheus-graphql-client.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: e02463ebba831a7d044e68be7f21aa39b4fba099002f076f46478158b913b2a7+-- hash: d8afe2a76ad3163ac3b8f0ac2cac8965a875cbcf8d86ea660ac0a65d325f71de  name:           morpheus-graphql-client-version:        0.17.0+version:        0.18.0 synopsis:       Morpheus GraphQL Client description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql, client@@ -27,14 +27,19 @@     test/Case/Github/schema.gql     test/Case/Interface/schema.gql     test/Case/LowercaseTypeName/schema.gql+    test/Case/Scalar/schema.gql     test/Case/Enum/response.json     test/Case/Github/response.json     test/Case/Interface/response.json+    test/Case/JSON/Custom/Errors/response.json     test/Case/JSON/Custom/Mutation/response.json+    test/Case/JSON/Custom/NoResponseOrError/response.json+    test/Case/JSON/Custom/PartialResponse/response.json     test/Case/JSON/Custom/Query/response.json     test/Case/JSON/Custom/schema.json     test/Case/JSON/Custom/Subscription/response.json     test/Case/LowercaseTypeName/response.json+    test/Case/Scalar/response.json  source-repository head   type: git@@ -67,7 +72,8 @@       aeson >=1.4.4.0 && <=1.6     , base >=4.7 && <5     , bytestring >=0.10.4 && <0.11-    , morpheus-graphql-core >=0.17.0 && <0.18.0+    , morpheus-graphql-code-gen >=0.18.0 && <0.19.0+    , morpheus-graphql-core >=0.18.0 && <0.19.0     , mtl >=2.0 && <=3.0     , relude >=0.3.0     , template-haskell >=2.0 && <=3.0@@ -76,17 +82,21 @@     , unordered-containers >=0.2.8.0 && <0.3   default-language: Haskell2010 -test-suite morpheus-client-test+test-suite morpheus-graphql-client-test   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:       Case.Enum.Test       Case.Github.Test       Case.Interface.Test+      Case.JSON.Custom.Errors       Case.JSON.Custom.Mutation+      Case.JSON.Custom.NoResponseOrError+      Case.JSON.Custom.PartialResponse       Case.JSON.Custom.Query       Case.JSON.Custom.Subscription       Case.LowercaseTypeName.Test+      Case.Scalar.Test       Spec.Utils       Paths_morpheus_graphql_client   hs-source-dirs:@@ -98,7 +108,8 @@     , bytestring >=0.10.4 && <0.11     , directory >=1.0     , morpheus-graphql-client-    , morpheus-graphql-core >=0.17.0 && <0.18.0+    , morpheus-graphql-code-gen >=0.18.0 && <0.19.0+    , morpheus-graphql-core >=0.18.0 && <0.19.0     , mtl >=2.0 && <=3.0     , relude >=0.3.0     , tasty
src/Data/Morpheus/Client.hs view
@@ -4,11 +4,14 @@ module Data.Morpheus.Client   ( gql,     Fetch (..),+    FetchError(..),     defineQuery,     defineByDocument,     defineByDocumentFile,+    defineByDocumentFile',     defineByIntrospection,     defineByIntrospectionFile,+    defineByIntrospectionFile',     ScalarValue (..),     DecodeScalar (..),     EncodeScalar (..),@@ -29,11 +32,14 @@ import Data.Morpheus.Client.JSONSchema.Parse   ( decodeIntrospection,   )+import Data.Morpheus.Client.Internal.Types+  ( FetchError(..),+  ) import Data.Morpheus.Core   ( parseFullSchema,   ) import Data.Morpheus.Internal.Ext-  ( Eventless,+  ( GQLResult,   ) import Data.Morpheus.QuasiQuoter (gql) import Data.Morpheus.Types.GQLScalar@@ -58,15 +64,23 @@   qAddDependentFile filePath   defineByDocument (L.readFile filePath) args +-- | This variant exposes 'Q FilePath' enabling the use of TH to generate the 'FilePath'. For example, https://hackage.haskell.org/package/file-embed-0.0.13.0/docs/Data-FileEmbed.html#v:makeRelativeToProject can be used to handle multi package projects more reliably.+defineByDocumentFile' :: Q FilePath -> (ExecutableDocument, String) -> Q [Dec]+defineByDocumentFile' qFilePath args = qFilePath >>= flip defineByDocumentFile args+ defineByIntrospectionFile :: FilePath -> (ExecutableDocument, String) -> Q [Dec] defineByIntrospectionFile filePath args = do   qAddDependentFile filePath   defineByIntrospection (L.readFile filePath) args +-- | This variant exposes 'Q FilePath' enabling the use of TH to generate the 'FilePath'. For example, https://hackage.haskell.org/package/file-embed-0.0.13.0/docs/Data-FileEmbed.html#v:makeRelativeToProject can be used to handle multi package projects more reliably.+defineByIntrospectionFile' :: Q FilePath -> (ExecutableDocument, String) -> Q [Dec]+defineByIntrospectionFile' qFilePath args = qFilePath >>= flip defineByIntrospectionFile args+ defineByDocument :: IO ByteString -> (ExecutableDocument, String) -> Q [Dec] defineByDocument doc = defineQuery (schemaByDocument doc) -schemaByDocument :: IO ByteString -> IO (Eventless (Schema VALID))+schemaByDocument :: IO ByteString -> IO (GQLResult (Schema VALID)) schemaByDocument = fmap parseFullSchema  defineByIntrospection :: IO ByteString -> (ExecutableDocument, String) -> Q [Dec]
src/Data/Morpheus/Client/Build.hs view
@@ -29,7 +29,7 @@     renderGQLErrors,   ) import Data.Morpheus.Internal.Ext-  ( Eventless,+  ( GQLResult,     Result (..),   ) import Data.Morpheus.Types.Internal.AST@@ -41,7 +41,7 @@ import Language.Haskell.TH import Relude -defineQuery :: IO (Eventless (Schema VALID)) -> (ExecutableDocument, String) -> Q [Dec]+defineQuery :: IO (GQLResult (Schema VALID)) -> (ExecutableDocument, String) -> Q [Dec] defineQuery ioSchema (query, src) = do   schema <- runIO ioSchema   case schema >>= (`validateWith` query) of@@ -51,7 +51,7 @@         warnings       } -> gqlWarnings warnings >> declareClient src result -validateWith :: Schema VALID -> ExecutableDocument -> Eventless ClientDefinition+validateWith :: Schema VALID -> ExecutableDocument -> GQLResult ClientDefinition validateWith   schema   rawRequest@ExecutableDocument
src/Data/Morpheus/Client/Declare/Aeson.hs view
@@ -28,38 +28,35 @@     mkFieldsE,   ) import Data.Morpheus.Client.Internal.Types-  ( ClientConsD,+  ( ClientConstructorDefinition (..),     ClientTypeDefinition (..),     TypeNameTH (..),   ) import Data.Morpheus.Client.Internal.Utils   ( isEnum,   )-import Data.Morpheus.Internal.TH+import Data.Morpheus.CodeGen.Internal.TH   ( _',     applyCons,+    camelCaseTypeName,     funDSimple,     toCon,     toName,     toString,     v',   )-import Data.Morpheus.Internal.Utils-  ( nameSpaceType,-  ) import Data.Morpheus.Types.GQLScalar   ( scalarFromJSON,     scalarToJSON,   ) import Data.Morpheus.Types.Internal.AST-  ( ConsD (..),-    FieldName,-    Message,+  ( FieldName,+    GQLError,+    Msg (msg),     TypeKind (..),-    TypeName (..),+    TypeName,+    internal,     isResolverType,-    msg,-    toFieldName,   ) import qualified Data.Text as T import Language.Haskell.TH@@ -74,7 +71,6 @@     cxt,     instanceD,     tupP,-    varE,   ) import Relude hiding (toString) @@ -85,7 +81,7 @@   | isResolverType kind = [deriveFromJSON]   | otherwise = [deriveToJSON] -failure :: Message -> Q a+failure :: GQLError -> Q a failure = fail . show  deriveScalarJSON :: [ClientTypeDefinition -> DecQ]@@ -93,7 +89,7 @@  deriveScalarFromJSON :: ClientTypeDefinition -> DecQ deriveScalarFromJSON ClientTypeDefinition {clientTypeName} =-  defineFromJSON clientTypeName (varE 'scalarFromJSON)+  defineFromJSON clientTypeName [|scalarFromJSON|]  deriveScalarToJSON :: ClientTypeDefinition -> DecQ deriveScalarToJSON@@ -102,12 +98,12 @@     } = instanceD (cxt []) typeDef body     where       typeDef = applyCons ''ToJSON [typename]-      body = [funDSimple 'toJSON [] (varE 'scalarToJSON)]+      body = [funDSimple 'toJSON [] [|scalarToJSON|]]  -- FromJSON deriveFromJSON :: ClientTypeDefinition -> DecQ deriveFromJSON ClientTypeDefinition {clientCons = [], clientTypeName} =-  failure $+  failure $ internal $     "Type "       <> msg (typename clientTypeName)       <> " Should Have at least one Constructor"@@ -126,8 +122,8 @@     defineFromJSON clientTypeName $       aesonUnionObject typeD -aesonObject :: [FieldName] -> ClientConsD cat -> ExpQ-aesonObject tNamespace con@ConsD {cName} =+aesonObject :: [FieldName] -> ClientConstructorDefinition -> ExpQ+aesonObject tNamespace con@ClientConstructorDefinition {cName} =   withBody     <$> aesonObjectBody tNamespace con   where@@ -136,13 +132,13 @@         (AppE (VarE 'withObject) name)         (LamE [v'] body)     name :: Exp-    name = toString (nameSpaceType tNamespace cName)+    name = toString (camelCaseTypeName tNamespace cName) -aesonObjectBody :: [FieldName] -> ClientConsD cat -> ExpQ-aesonObjectBody namespace ConsD {cName, cFields} =+aesonObjectBody :: [FieldName] -> ClientConstructorDefinition -> ExpQ+aesonObjectBody namespace ClientConstructorDefinition {cName, cFields} =   decodeObjectE     entry-    (nameSpaceType namespace cName)+    (camelCaseTypeName namespace cName)     cFields  entry :: Bool -> Name@@ -156,7 +152,7 @@     { clientCons,       clientTypeName = TypeNameTH {namespace, typename}     } =-    appE (varE 'takeValueType) $+    appE [|takeValueType|] $       matchWith elseCondition f clientCons     where       elseCondition =@@ -164,7 +160,7 @@           . aesonObjectBody             namespace           <$> find ((typename ==) . cName) clientCons-      f cons@ConsD {cName, cFields} =+      f cons@ClientConstructorDefinition {cName, cFields} =         ( tupP [toString cName, if null cFields then _' else v'],           aesonObjectBody namespace cons         )@@ -179,7 +175,7 @@  namespaced :: TypeNameTH -> TypeName namespaced TypeNameTH {namespace, typename} =-  nameSpaceType namespace typename+  camelCaseTypeName namespace typename  defineFromJSON :: TypeNameTH -> ExpQ -> DecQ defineFromJSON name expr = instanceD (cxt []) typeDef body@@ -187,21 +183,21 @@     typeDef = applyCons ''FromJSON [namespaced name]     body = [funDSimple 'parseJSON [] expr] -aesonFromJSONEnumBody :: TypeNameTH -> [ClientConsD cat] -> ExpQ+aesonFromJSONEnumBody :: TypeNameTH -> [ClientConstructorDefinition] -> ExpQ aesonFromJSONEnumBody TypeNameTH {typename} = matchWith (Just (v', failExp)) f   where-    f :: ClientConsD cat -> (PatQ, ExpQ)-    f ConsD {cName} =+    f :: ClientConstructorDefinition -> (PatQ, ExpQ)+    f ClientConstructorDefinition {cName} =       ( toString cName,-        appE (varE 'pure) $ toCon $ nameSpaceType [toFieldName typename] cName+        appE [|pure|] $ toCon $ camelCaseTypeName [typename] cName       ) -aesonToJSONEnumBody :: TypeNameTH -> [ClientConsD cat] -> ExpQ+aesonToJSONEnumBody :: TypeNameTH -> [ClientConstructorDefinition] -> ExpQ aesonToJSONEnumBody TypeNameTH {typename} = matchWith Nothing f   where-    f :: ClientConsD cat -> (PatQ, ExpQ)-    f ConsD {cName} =-      ( conP (toName $ nameSpaceType [toFieldName typename] cName) [],+    f :: ClientConstructorDefinition -> (PatQ, ExpQ)+    f ClientConstructorDefinition {cName} =+      ( conP (toName $ camelCaseTypeName [typename] cName) [],         toString cName       ) @@ -215,7 +211,7 @@ deriveToJSON   ClientTypeDefinition     { clientTypeName = TypeNameTH {typename},-      clientCons = [ConsD {cFields}]+      clientCons = [ClientConstructorDefinition {cFields}]     } =     instanceD (cxt []) appHead methods     where
src/Data/Morpheus/Client/Declare/Client.hs view
@@ -23,7 +23,7 @@     ClientTypeDefinition (..),     TypeNameTH (..),   )-import Data.Morpheus.Internal.TH (toCon)+import Data.Morpheus.CodeGen.Internal.TH (toCon) import Language.Haskell.TH import Relude hiding (Type) 
src/Data/Morpheus/Client/Declare/Type.hs view
@@ -11,22 +11,21 @@ where  import Data.Morpheus.Client.Internal.Types-  ( ClientConsD,+  ( ClientConstructorDefinition (..),     ClientTypeDefinition (..),     TypeNameTH (..),   ) import Data.Morpheus.Client.Internal.Utils   ( isEnum,   )-import Data.Morpheus.Internal.TH-  ( declareTypeRef,-    nameSpaceType,+import Data.Morpheus.CodeGen.Internal.TH+  ( camelCaseTypeName,+    declareTypeRef,     toCon,     toName,   ) import Data.Morpheus.Types.Internal.AST   ( ANY,-    ConsD (..),     FieldDefinition (..),     FieldName,     TypeKind (..),@@ -56,13 +55,13 @@     where       derive className = DerivClause Nothing [ConT className] -declareCons :: TypeNameTH -> [ClientConsD ANY] -> [Con]+declareCons :: TypeNameTH -> [ClientConstructorDefinition] -> [Con] declareCons TypeNameTH {namespace, typename} clientCons   | isEnum clientCons = map consE clientCons   | otherwise = map consR clientCons   where-    consE ConsD {cName} = NormalC (mkConName namespace (typename <> cName)) []-    consR ConsD {cName, cFields} =+    consE ClientConstructorDefinition {cName} = NormalC (mkTypeName namespace typename cName) []+    consR ClientConstructorDefinition {cName, cFields} =       RecC         (mkConName namespace cName)         (map declareField cFields)@@ -74,5 +73,8 @@     declareTypeRef toCon fieldType   ) +mkTypeName :: [FieldName] -> TypeName -> TypeName -> Name+mkTypeName namespace typename = mkConName namespace . camelCaseTypeName [typename]+ mkConName :: [FieldName] -> TypeName -> Name-mkConName namespace = toName . nameSpaceType namespace+mkConName namespace = toName . camelCaseTypeName namespace
src/Data/Morpheus/Client/Fetch.hs view
@@ -21,10 +21,13 @@ import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import Data.ByteString.Lazy (ByteString)+import Data.Morpheus.Client.Internal.Types+  ( FetchError (..),+  ) import Data.Morpheus.Client.JSONSchema.Types   ( JSONResponse (..),   )-import Data.Morpheus.Internal.TH+import Data.Morpheus.CodeGen.Internal.TH   ( applyCons,     toCon,     typeInstanceDec,@@ -55,14 +58,15 @@     FieldName ->     (ByteString -> m ByteString) ->     Args a ->-    m (Either String a)-  __fetch strQuery opName trans vars = (eitherDecode >=> processResponse) <$> trans (encode gqlReq)+    m (Either (FetchError a) a)+  __fetch strQuery opName trans vars = ((first FetchErrorParseFailure . eitherDecode) >=> processResponse) <$> trans (encode gqlReq)     where       gqlReq = GQLRequest {operationName = Just opName, query = pack strQuery, variables = fixVars (toJSON vars)}       --------------------------------------------------------------      processResponse JSONResponse {responseData = Just x} = Right x-      processResponse invalidResponse = Left (show invalidResponse)-  fetch :: (Monad m, FromJSON a) => (ByteString -> m ByteString) -> Args a -> m (Either String a)+      processResponse JSONResponse {responseData = Just x, responseErrors = []} = Right x+      processResponse JSONResponse {responseData = Nothing, responseErrors = []} = Left FetchErrorNoResult+      processResponse JSONResponse {responseData = result, responseErrors = (x : xs)} = Left $ FetchErrorProducedErrors (x :| xs) result+  fetch :: (Monad m, FromJSON a) => (ByteString -> m ByteString) -> Args a -> m (Either (FetchError a) a)  deriveFetch :: Type -> TypeName -> String -> Q [Dec] deriveFetch resultType typeName queryString =
src/Data/Morpheus/Client/Internal/TH.hs view
@@ -21,18 +21,18 @@ where  import Data.Foldable (foldr1)-import Data.Morpheus.Internal.TH-  ( toCon,+import Data.Morpheus.CodeGen.Internal.TH+  ( camelCaseFieldName,+    toCon,     toName,     toString,     toVar,     v',     vars,   )-import Data.Morpheus.Internal.Utils (nameSpaceField) import Data.Morpheus.Types.Internal.AST   ( FieldDefinition (..),-    TypeName (..),+    TypeName,     isNullable,   ) import Language.Haskell.TH@@ -56,21 +56,21 @@   appE     (toVar 'fail)     ( uInfixE-        (appE (varE 'show) v')-        (varE '(<>))+        (appE [|show|] v')+        [|(<>)|]         (stringE " is Not Valid Union Constructor")     )  decodeObjectE :: (Bool -> Name) -> TypeName -> [FieldDefinition cat s] -> ExpQ-decodeObjectE _ conName [] = appE (varE 'pure) (toCon conName)+decodeObjectE _ conName [] = appE [|pure|] (toCon conName) decodeObjectE funName conName fields =   uInfixE     (toCon conName)-    (varE '(<$>))+    [|(<$>)|]     (foldr1 withApplicative $ map (defField funName) fields)  withApplicative :: ExpQ -> ExpQ -> ExpQ-withApplicative x = uInfixE x (varE '(<*>))+withApplicative x = uInfixE x [|(<*>)|]  defField :: (Bool -> Name) -> FieldDefinition cat s -> ExpQ defField f field@FieldDefinition {fieldName} = uInfixE v' (varE $ f (isNullable field)) (toString fieldName)@@ -101,19 +101,19 @@ mkEntryWith conName f FieldDefinition {fieldName} =   AppE     (AppE (VarE f) (toString fieldName))-    (toVar $ nameSpaceField conName fieldName)+    (toVar $ camelCaseFieldName conName fieldName)  -- | -- input: -- >>>--- destructRecord "User" ["name","id"]+-- WAS WAS destructRecord "User" ["name","id"] -- >>> -- -- expression: -- >>>--- (User name id)+-- WAS WAS (User name id) -- >>> destructRecord :: TypeName -> [FieldDefinition cat s] -> PatQ destructRecord conName fields = conP (toName conName) (vars names)   where-    names = map (nameSpaceField conName . fieldName) fields+    names = map (camelCaseFieldName conName . fieldName) fields
src/Data/Morpheus/Client/Internal/Types.hs view
@@ -1,18 +1,20 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}  module Data.Morpheus.Client.Internal.Types   ( ClientTypeDefinition (..),     TypeNameTH (..),     ClientDefinition (..),-    ClientConsD,+    ClientConstructorDefinition (..),+    FetchError (..)   ) where  import Data.Morpheus.Types.Internal.AST   ( ANY,-    ConsD (..),     FieldDefinition,     FieldName,+    GQLErrors,     TypeKind,     TypeName,     VALID,@@ -25,11 +27,15 @@   }   deriving (Show) -type ClientConsD c = ConsD (FieldDefinition c VALID)+data ClientConstructorDefinition = ClientConstructorDefinition+  { cName :: TypeName,+    cFields :: [FieldDefinition ANY VALID]+  }+  deriving (Show)  data ClientTypeDefinition = ClientTypeDefinition   { clientTypeName :: TypeNameTH,-    clientCons :: [ClientConsD ANY],+    clientCons :: [ClientConstructorDefinition],     clientKind :: TypeKind   }   deriving (Show)@@ -39,3 +45,9 @@     clientTypes :: [ClientTypeDefinition]   }   deriving (Show)++data FetchError a+  = FetchErrorParseFailure String+  | FetchErrorProducedErrors GQLErrors (Maybe a)+  | FetchErrorNoResult+  deriving (Show, Eq, Generic)
src/Data/Morpheus/Client/Internal/Utils.hs view
@@ -6,15 +6,14 @@   ) where -import Data.Morpheus.Types.Internal.AST-  ( ConsD (..),+import Data.Morpheus.Client.Internal.Types+  ( ClientConstructorDefinition (cFields),   ) import Relude  removeDuplicates :: Eq a => [a] -> [a] removeDuplicates = fst . splitDuplicates --- elems -> (unique elements, duplicate elems) splitDuplicates :: Eq a => [a] -> ([a], [a]) splitDuplicates = collectElems ([], [])   where@@ -24,5 +23,5 @@       | x `elem` collected = collectElems (collected, errors <> [x]) xs       | otherwise = collectElems (collected <> [x], errors) xs -isEnum :: [ConsD f] -> Bool+isEnum :: [ClientConstructorDefinition] -> Bool isEnum = all (null . cFields)
src/Data/Morpheus/Client/JSONSchema/Parse.hs view
@@ -11,6 +11,7 @@   ) where +import Control.Monad.Except (MonadError (throwError)) import Data.Aeson import Data.ByteString.Lazy (ByteString) import Data.Morpheus.Client.JSONSchema.TypeKind (TypeKind (..))@@ -28,12 +29,11 @@   ( defaultConfig,     validateSchema,   )-import Data.Morpheus.Error (globalErrorMessage) import Data.Morpheus.Internal.Ext-  ( Eventless,+  ( GQLResult,   ) import Data.Morpheus.Internal.Utils-  ( Failure (..),+  ( empty,     fromElems,   ) import qualified Data.Morpheus.Types.Internal.AST as AST@@ -43,43 +43,42 @@   ( ANY,     ArgumentDefinition (..),     CONST,-    DataTypeWrapper (..),     FieldDefinition,+    GQLError,     IN,-    Message,     OUT,     OperationType (..),     RootOperationTypeDefinition (..),     SchemaDefinition (..),     TypeContent (..),     TypeDefinition (..),-    TypeName,-    TypeWrapper,+    TypeRef (..),+    TypeWrapper (..),     VALID,-    ValidationErrors,     buildSchema,     createScalarType,     mkEnumContent,-    mkInputValue,+    mkField,+    mkMaybeType,     mkObjectField,     mkType,     mkUnionContent,     msg,     toAny,-    toHSWrappers,   ) import Relude hiding   ( ByteString,     Type,+    empty,     fromList,     show,   ) import Prelude (show) -decoderError :: Message -> Eventless a-decoderError = failure . globalErrorMessage+decoderError :: GQLError -> GQLResult a+decoderError = throwError -decodeIntrospection :: ByteString -> Eventless (AST.Schema VALID)+decodeIntrospection :: ByteString -> GQLResult (AST.Schema VALID) decodeIntrospection jsonDoc = case jsonSchema of   Left errors -> decoderError $ msg errors   Right@@ -96,13 +95,13 @@       buildSchema (Just schemaDef, gqlTypes, empty) >>= validate   Right res -> decoderError (msg $ show res)   where-    validate :: AST.Schema CONST -> Eventless (AST.Schema VALID)+    validate :: AST.Schema CONST -> GQLResult (AST.Schema VALID)     validate = validateSchema False defaultConfig     jsonSchema :: Either String (JSONResponse Introspection)     jsonSchema = eitherDecode jsonDoc  mkSchemaDef ::-  (Monad m, Failure ValidationErrors m) =>+  (Monad m, MonadError GQLError m) =>   Schema ->   m SchemaDefinition mkSchemaDef@@ -121,7 +120,7 @@         )  class ParseJSONSchema a b where-  parse :: a -> Eventless b+  parse :: a -> GQLResult b  instance ParseJSONSchema Type [TypeDefinition ANY CONST] where   parse Type {name = Just typeName, kind = SCALAR} =@@ -146,25 +145,25 @@  instance ParseJSONSchema Field (FieldDefinition OUT CONST) where   parse Field {fieldName, fieldArgs, fieldType} = do-    (wrappers, typename) <- fieldTypeFromJSON fieldType+    TypeRef typename wrappers <- fieldTypeFromJSON fieldType     args <- traverse genArg fieldArgs >>= fromElems     pure $ mkObjectField args fieldName wrappers typename     where       genArg InputValue {inputName = argName, inputType = argType} =-        ArgumentDefinition . uncurry (mkInputValue argName) <$> fieldTypeFromJSON argType+        ArgumentDefinition . mkField Nothing argName <$> fieldTypeFromJSON argType  instance ParseJSONSchema InputValue (FieldDefinition IN CONST) where-  parse InputValue {inputName, inputType} = uncurry (mkInputValue inputName) <$> fieldTypeFromJSON inputType+  parse InputValue {inputName, inputType} = mkField Nothing inputName <$> fieldTypeFromJSON inputType -fieldTypeFromJSON :: Type -> Eventless ([TypeWrapper], TypeName)-fieldTypeFromJSON = fmap toHs . fieldTypeRec []-  where-    toHs (w, t) = (toHSWrappers w, t)-    fieldTypeRec ::-      [DataTypeWrapper] -> Type -> Eventless ([DataTypeWrapper], TypeName)-    fieldTypeRec acc Type {kind = LIST, ofType = Just ofType} =-      fieldTypeRec (ListType : acc) ofType-    fieldTypeRec acc Type {kind = NON_NULL, ofType = Just ofType} =-      fieldTypeRec (NonNullType : acc) ofType-    fieldTypeRec acc Type {name = Just name} = pure (acc, name)-    fieldTypeRec _ x = decoderError $ "Unsupported Field" <> msg (show x)+fieldTypeFromJSON :: Type -> GQLResult TypeRef+fieldTypeFromJSON Type {kind = NON_NULL, ofType = Just ofType} = withListNonNull <$> fieldTypeFromJSON ofType+fieldTypeFromJSON Type {kind = LIST, ofType = Just ofType} = withList <$> fieldTypeFromJSON ofType+fieldTypeFromJSON Type {name = Just name} = pure (TypeRef name mkMaybeType)+fieldTypeFromJSON x = decoderError $ "Unsupported Field" <> msg (show x)++withList :: TypeRef -> TypeRef+withList (TypeRef name x) = TypeRef name (TypeList x False)++withListNonNull :: TypeRef -> TypeRef+withListNonNull (TypeRef name (TypeList y _)) = TypeRef name (TypeList y True)+withListNonNull (TypeRef name (BaseType _)) = TypeRef name (BaseType True)
src/Data/Morpheus/Client/JSONSchema/Types.hs view
@@ -96,10 +96,11 @@ instance FromJSON a => FromJSON (JSONResponse a) where   parseJSON = withObject "JSONResponse" objectParser     where-      objectParser o = JSONResponse <$> o .:? "data" <*> o .:? "errors"+      objectParser o =+        JSONResponse <$> o .:? "data" <*> o .:? "errors" .!= []  data JSONResponse a = JSONResponse   { responseData :: Maybe a,-    responseErrors :: Maybe [GQLError]+    responseErrors :: [GQLError]   }   deriving (Generic, Show, ToJSON)
src/Data/Morpheus/Client/Transform/Core.hs view
@@ -20,28 +20,28 @@   ) where +import Control.Monad.Except (MonadError (throwError)) import Data.Morpheus.Client.Internal.Types   ( ClientTypeDefinition (..),   )+import Data.Morpheus.CodeGen.Internal.TH+  ( camelCaseTypeName,+  ) import Data.Morpheus.Error   ( deprecatedField,-    globalErrorMessage,   ) import Data.Morpheus.Internal.Ext-  ( Eventless,+  ( GQLResult,     Result (..),   ) import Data.Morpheus.Internal.Utils-  ( Failure (..),-    nameSpaceType,-    selectBy,+  ( selectBy,   ) import Data.Morpheus.Types.Internal.AST   ( ANY,     Directives,     FieldName,-    GQLErrors,-    Message,+    GQLError,     RAW,     Ref (..),     Schema (..),@@ -50,14 +50,13 @@     TypeDefinition (..),     TypeName,     VALID,-    ValidationError,     VariableDefinitions,-    hsTypeName,+    internal,     isNotSystemTypeName,     lookupDeprecated,     lookupDeprecatedReason,     msg,-    toGQLError,+    typeDefinitions,   ) import Relude @@ -67,7 +66,7 @@   { runConverter ::       ReaderT         Env-        Eventless+        GQLResult         a   }   deriving@@ -75,23 +74,21 @@       Applicative,       Monad,       MonadReader Env,-      Failure GQLErrors+      MonadError GQLError     ) -instance Failure ValidationError Converter where-  failure err = failure [toGQLError err]- newtype UpdateT m a = UpdateT {updateTState :: a -> m a}  resolveUpdates :: Monad m => a -> [UpdateT m a] -> m a resolveUpdates a = foldlM (&) a . fmap updateTState -compileError :: Message -> GQLErrors-compileError x =-  globalErrorMessage $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"+compileError :: GQLError -> GQLError+compileError x = internal $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"  getType :: TypeName -> Converter (TypeDefinition ANY VALID)-getType typename = asks fst >>= selectBy (compileError $ " can't find Type" <> msg typename) typename+getType typename =+  asks (typeDefinitions . fst)+    >>= selectBy (compileError $ " can't find Type" <> msg typename) typename  customScalarTypes :: TypeName -> [TypeName] customScalarTypes typeName@@ -104,24 +101,24 @@     fromKind :: TypeContent TRUE a VALID -> Converter ([ClientTypeDefinition], [TypeName])     fromKind DataEnum {} = pure ([], [typeName])     fromKind DataScalar {} = pure ([], customScalarTypes typeName)-    fromKind _ = failure $ compileError "Invalid schema Expected scalar"+    fromKind _ = throwError $ compileError "Invalid schema Expected scalar"  typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName typeFrom path TypeDefinition {typeName, typeContent} = __typeFrom typeContent   where-    __typeFrom DataScalar {} = hsTypeName typeName-    __typeFrom DataObject {} = nameSpaceType path typeName-    __typeFrom DataInterface {} = nameSpaceType path typeName-    __typeFrom DataUnion {} = nameSpaceType path typeName+    __typeFrom DataObject {} = camelCaseTypeName path typeName+    __typeFrom DataInterface {} = camelCaseTypeName path typeName+    __typeFrom DataUnion {} = camelCaseTypeName path typeName     __typeFrom _ = typeName  deprecationWarning :: Directives VALID -> (FieldName, Ref FieldName) -> Converter () deprecationWarning dirs (typename, ref) = case lookupDeprecated dirs of-  Just deprecation -> Converter $ lift $ Success {result = (), warnings, events = []}+  Just deprecation -> Converter $ lift $ Success {result = (), warnings}     where       warnings =-        deprecatedField-          typename-          ref-          (lookupDeprecatedReason deprecation)+        [ deprecatedField+            typename+            ref+            (lookupDeprecatedReason deprecation)+        ]   Nothing -> pure ()
src/Data/Morpheus/Client/Transform/Inputs.hs view
@@ -13,7 +13,7 @@ where  import Data.Morpheus.Client.Internal.Types-  ( ClientConsD,+  ( ClientConstructorDefinition (..),     ClientTypeDefinition (..),     TypeNameTH (..),   )@@ -29,12 +29,11 @@     typeFrom,   ) import Data.Morpheus.Internal.Utils-  ( elems,-    empty,+  ( empty,   ) import Data.Morpheus.Types.Internal.AST   ( ANY,-    ConsD (..),+    DataEnumValue (DataEnumValue, enumName),     FieldDefinition (..),     IN,     Operation (..),@@ -49,7 +48,6 @@     Variable (..),     VariableDefinitions,     getOperationName,-    mkConsEnum,     toAny,   ) import Relude hiding (empty)@@ -68,9 +66,9 @@         { clientTypeName = TypeNameTH [] cName,           clientKind = KindInputObject,           clientCons =-            [ ConsD+            [ ClientConstructorDefinition                 { cName,-                  cFields = fieldD <$> elems variables+                  cFields = fieldD <$> toList variables                 }             ]         }@@ -96,7 +94,7 @@   [TypeName] ->   Converter [ClientTypeDefinition] renderNonOutputTypes leafTypes = do-  variables <- asks (elems . snd)+  variables <- asks (toList . snd)   inputTypeRequests <- resolveUpdates [] $ fmap (UpdateT . exploreInputTypeNames . typeConName . variableType) variables   concat <$> traverse buildInputType (removeDuplicates $ inputTypeRequests <> leafTypes) @@ -110,7 +108,7 @@         scanType (DataInputObject fields) =           resolveUpdates             (name : collected)-            (toInputTypeD <$> elems fields)+            (toInputTypeD <$> toList fields)           where             toInputTypeD :: FieldDefinition IN VALID -> UpdateT Converter [TypeName]             toInputTypeD FieldDefinition {fieldType = TypeRef {typeConName}} =@@ -128,12 +126,12 @@       where         subTypes :: TypeContent TRUE ANY VALID -> Converter [ClientTypeDefinition]         subTypes (DataInputObject inputFields) = do-          fields <- traverse toClientFieldDefinition (elems inputFields)+          fields <- traverse toClientFieldDefinition (toList inputFields)           pure             [ mkInputType                 typeName                 KindInputObject-                [ ConsD+                [ ClientConstructorDefinition                     { cName = typeName,                       cFields = fmap toAny fields                     }@@ -155,7 +153,10 @@             ]         subTypes _ = pure [] -mkInputType :: TypeName -> TypeKind -> [ClientConsD ANY] -> ClientTypeDefinition+mkConsEnum :: DataEnumValue s -> ClientConstructorDefinition+mkConsEnum DataEnumValue {enumName} = ClientConstructorDefinition enumName []++mkInputType :: TypeName -> TypeKind -> [ClientConstructorDefinition] -> ClientTypeDefinition mkInputType typename clientKind clientCons =   ClientTypeDefinition     { clientTypeName = TypeNameTH [] typename,
src/Data/Morpheus/Client/Transform/Selection.hs view
@@ -12,8 +12,9 @@   ) where +import Control.Monad.Except (MonadError (throwError)) import Data.Morpheus.Client.Internal.Types-  ( ClientConsD,+  ( ClientConstructorDefinition (..),     ClientDefinition (..),     ClientTypeDefinition (..),     TypeNameTH (..),@@ -21,18 +22,15 @@ import Data.Morpheus.Client.Transform.Core (Converter (..), compileError, deprecationWarning, getType, leafType, typeFrom) import Data.Morpheus.Client.Transform.Inputs (renderNonOutputTypes, renderOperationArguments) import Data.Morpheus.Internal.Ext-  ( Eventless,+  ( GQLResult,   ) import Data.Morpheus.Internal.Utils-  ( Failure (..),-    elems,-    empty,+  ( empty,     keyOf,     selectBy,   ) import Data.Morpheus.Types.Internal.AST   ( ANY,-    ConsD (..),     FieldDefinition (..),     FieldName,     Operation (..),@@ -55,7 +53,6 @@     mkTypeRef,     msg,     toAny,-    toFieldName,   ) import Relude hiding (empty, show) import Prelude (show)@@ -64,7 +61,7 @@   Schema VALID ->   VariableDefinitions RAW ->   Operation VALID ->-  Eventless ClientDefinition+  GQLResult ClientDefinition toClientDefinition schema vars = flip runReaderT (schema, vars) . runConverter . genOperation  genOperation :: Operation VALID -> Converter ClientDefinition@@ -117,13 +114,13 @@   TypeDefinition ANY VALID ->   SelectionSet VALID ->   Converter-    ( ClientConsD ANY,+    ( ClientConstructorDefinition,       [ClientTypeDefinition],       [TypeName]     ) genConsD path cName datatype selSet = do-  (cFields, subTypes, requests) <- unzip3 <$> traverse genField (elems selSet)-  pure (ConsD {cName, cFields}, concat subTypes, concat requests)+  (cFields, subTypes, requests) <- unzip3 <$> traverse genField (toList selSet)+  pure (ClientConstructorDefinition {cName, cFields}, concat subTypes, concat requests)   where     genField ::       Selection VALID ->@@ -165,10 +162,14 @@   leafType dType subTypesBySelection path dType Selection {selectionContent = SelectionSet selectionSet} =   genRecordType path (typeFrom [] dType) dType selectionSet-subTypesBySelection path dType Selection {selectionContent = UnionSelection unionSelections} =+subTypesBySelection path dType Selection {selectionContent = UnionSelection interface unionSelections} =   do     (clientCons, subTypes, requests) <--      unzip3 <$> traverse getUnionType (elems unionSelections)+      unzip3+        <$> traverse+          getUnionType+          ( UnionTag (typeName dType) interface : toList unionSelections+          )     pure       ( ClientTypeDefinition           { clientTypeName = TypeNameTH path (typeFrom [] dType),@@ -201,7 +202,7 @@           { fieldName = "__typename",             fieldDescription = Nothing,             fieldType = mkTypeRef "String",-            fieldDirectives = [],+            fieldDirectives = empty,             fieldContent = Nothing           }     | otherwise = withTypeContent typeContent@@ -211,7 +212,7 @@       withTypeContent DataInterface {interfaceFields} =         selectBy selError selectionName interfaceFields >>= processDeprecation       withTypeContent dt =-        failure (compileError $ "Type should be output Object \"" <> msg (show dt))+        throwError (compileError $ "Type should be output Object \"" <> msg (show dt))       selError = compileError $ "can't find field " <> msg selectionName <> " on type: " <> msg (show typeContent)       processDeprecation         FieldDefinition@@ -227,4 +228,6 @@             checkDeprecated =               deprecationWarning                 fieldDirectives-                (toFieldName typeName, Ref {refName = selectionName, refPosition = selectionPosition})+                ( coerce typeName,+                  Ref {refName = selectionName, refPosition = selectionPosition}+                )
test/Case/Enum/Test.hs view
@@ -16,6 +16,7 @@   ) import Data.Morpheus.Client   ( Fetch (..),+    FetchError,     gql,   ) import Spec.Utils@@ -48,7 +49,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "Enum" -client :: IO (Either String MyQuery)+client :: IO (Either (FetchError MyQuery) MyQuery) client = fetch resolver MyQueryArgs {inputCity = CityAthens}  test :: TestTree
test/Case/Enum/response.json view
@@ -1,6 +1,6 @@ {   "data": {     "city": "Athens",-    "cities": ["Athens", "Sparta", "Corinth", "Delphi", "Argos"]+    "cities": ["Athens", "Sparta", "Corinth", "delphi", "argos"]   } }
test/Case/Enum/schema.gql view
@@ -2,8 +2,9 @@   Athens   Sparta   Corinth-  Delphi-  Argos+  # test lowercase enum+  delphi+  argos }  type Query {
test/Case/Github/Test.hs view
@@ -20,6 +20,7 @@   ( DecodeScalar (..),     EncodeScalar (..),     Fetch (..),+    FetchError,     ScalarValue (..),     gql,   )@@ -92,7 +93,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "Interface" -client :: IO (Either String GetTags)+client :: IO (Either (FetchError GetTags) GetTags) client =   fetch     resolver
test/Case/Interface/Test.hs view
@@ -18,6 +18,7 @@   ) import Data.Morpheus.Client   ( Fetch (..),+    FetchError,     gql,   ) import Data.Text (Text)@@ -76,7 +77,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "Interface" -client :: IO (Either String MyQuery)+client :: IO (Either (FetchError MyQuery) MyQuery) client = fetch resolver ()  testInterface :: TestTree@@ -88,39 +89,40 @@         ( MyQuery             { character =                 [ CharacterDeity-                    { name = "Deity Name",-                      power = "Deity Power",-                      __typename = "Deity"+                    { __typename = "Deity",+                      name = "Deity Name",+                      power = "Deity Power"                     },                   CharacterCharacter-                    { name = "Character Name",-                      __typename = "Character"+                    { __typename = "Character",+                      name = "Character Name"                     },                   CharacterHero-                    { name = "Hero Name",-                      hobby = "Deity Power",-                      __typename = "Hero"+                    { __typename = "Hero",+                      name = "Hero Name",+                      hobby = "Deity Power"                     }                 ],               character2 =                 [ Character2Character-                    { name1 = "test name",+                    { __typename = "Character",+                      name1 = "test name",                       name = "test name"                     }                 ],               character3 =                 [ Character3Hero-                    { hobby = "Hero Hobby",-                      name2 = "Hero name2",-                      __typename = "Hero"+                    { __typename = "Hero",+                      hobby = "Hero Hobby",+                      name2 = "Hero name2"                     },-                  Character3Deity-                    { name2 = "Hero name2",-                      __typename = "Deity"+                  Character3Character+                    { __typename = "Deity",+                      name2 = "Hero name2"                     },                   Character3Character-                    { name2 = "Character name2",-                      __typename = "Character"+                    { __typename = "Character",+                      name2 = "Character name2"                     }                 ],               character4 =@@ -128,8 +130,8 @@                     { __typename = "Character"                     },                   Character4Hero-                    { hobby = "Hero Hobby",-                      __typename = "Hero"+                    { __typename = "Hero",+                      hobby = "Hero Hobby"                     },                   Character4Character                     { __typename = "Deity"
test/Case/Interface/response.json view
@@ -19,7 +19,8 @@     "character2": [       {         "name1": "test name",-        "name": "test name"+        "name": "test name",+        "__typename": "Character"       }     ],     "character3": [
test/Case/Interface/schema.gql view
@@ -3,7 +3,7 @@ }  interface Supernatural {-  power: [String!]!+  power: String! }  type Hero implements Character {
+ test/Case/JSON/Custom/Errors.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Case.JSON.Custom.Errors+  ( test,+  )+where++import Data.ByteString.Lazy.Char8+  ( ByteString,+  )+import Data.List.NonEmpty+  ( NonEmpty (..),+  )+import Data.Morpheus.Client+  ( EncodeScalar (..),+    Fetch (..),+    FetchError (..),+    ScalarValue (..),+    gql,+  )+import Data.Morpheus.Types.Internal.AST+  ( Position (..),+    at,+    withPath,+  )+import Data.Text (Text)+import Spec.Utils+  ( defineClientWithJSON,+    mockApi,+  )+import Test.Tasty+  ( TestTree,+  )+import Test.Tasty.HUnit+  ( assertEqual,+    testCase,+  )+import Prelude+  ( ($),+    Either (..),+    Eq (..),+    IO,+    Maybe (..),+    Show,+  )++newtype GitTimestamp = GitTimestamp+  { unGitTimestamp :: Text+  }+  deriving (Eq, Show)++instance EncodeScalar GitTimestamp where+  encodeScalar (GitTimestamp x) = String x++defineClientWithJSON+  "JSON/Custom"+  [gql|+    query TestQuery+      {+        queryTypeName+      }+  |]++resolver :: ByteString -> IO ByteString+resolver = mockApi "JSON/Custom/Errors"++client :: IO (Either (FetchError TestQuery) TestQuery)+client = fetch resolver ()++test :: TestTree+test = testCase "test Errors" $ do+  value <- client+  assertEqual+    "test custom Errors"+    ( Left+        ( FetchErrorProducedErrors+            (("Failure" `at` Position {line = 3, column = 7}) `withPath` ["queryTypeName"] :| [])+            (Just TestQuery {queryTypeName = Just "TestQuery"})+        )+    )+    value
+ test/Case/JSON/Custom/Errors/response.json view
@@ -0,0 +1,19 @@+{+  "data": {+    "queryTypeName": "TestQuery"+  },+  "errors": [+    {+      "locations": [+        {+          "line": 3,+          "column": 7+        }+      ],+      "path": [+        "queryTypeName"+      ],+      "message": "Failure"+    }+  ]+}
test/Case/JSON/Custom/Mutation.hs view
@@ -18,6 +18,7 @@   ) import Data.Morpheus.Client   ( Fetch (..),+    FetchError,     gql,   ) import Data.Text (Text)@@ -52,7 +53,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "JSON/Custom/Mutation" -client :: IO (Either String TestMutation)+client :: IO (Either (FetchError TestMutation) TestMutation) client = fetch resolver ()  test :: TestTree
+ test/Case/JSON/Custom/NoResponseOrError.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Case.JSON.Custom.NoResponseOrError+  ( test,+  )+where++import Data.ByteString.Lazy.Char8+  ( ByteString,+  )+import Data.Morpheus.Client+  ( EncodeScalar (..),+    Fetch (..),+    FetchError (..),+    ScalarValue (..),+    gql,+  )+import Data.Text (Text)+import Spec.Utils+  ( defineClientWithJSON,+    mockApi,+  )+import Test.Tasty+  ( TestTree,+  )+import Test.Tasty.HUnit+  ( assertEqual,+    testCase,+  )+import Prelude+  ( Either (..),+    Eq (..),+    IO,+    Show,+    ($),+  )++newtype GitTimestamp = GitTimestamp+  { unGitTimestamp :: Text+  }+  deriving (Eq, Show)++instance EncodeScalar GitTimestamp where+  encodeScalar (GitTimestamp x) = String x++defineClientWithJSON+  "JSON/Custom"+  [gql|+    query TestQuery+      {+        queryTypeName+      }+  |]++resolver :: ByteString -> IO ByteString+resolver = mockApi "JSON/Custom/NoResponseOrError"++client :: IO (Either (FetchError TestQuery) TestQuery)+client = fetch resolver ()++test :: TestTree+test = testCase "test NoResponseOrError" $ do+  value <- client+  assertEqual+    "test custom NoResponseOrError"+    ( Left FetchErrorNoResult+    )+    value
+ test/Case/JSON/Custom/NoResponseOrError/response.json view
@@ -0,0 +1,1 @@+{}
+ test/Case/JSON/Custom/PartialResponse.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Case.JSON.Custom.PartialResponse+  ( test,+  )+where++import Data.ByteString.Lazy.Char8+  ( ByteString,+  )+import Data.Morpheus.Client+  ( EncodeScalar (..),+    Fetch (..),+    FetchError (..),+    ScalarValue (..),+    gql,+  )+import Data.Text (Text)+import Spec.Utils+  ( defineClientWithJSON,+    mockApi,+  )+import Test.Tasty+  ( TestTree,+  )+import Test.Tasty.HUnit+  ( assertEqual,+    testCase,+  )+import Prelude+  ( Either (..),+    Eq (..),+    IO,+    Show,+    String,+    ($),+  )++newtype GitTimestamp = GitTimestamp+  { unGitTimestamp :: Text+  }+  deriving (Eq, Show)++instance EncodeScalar GitTimestamp where+  encodeScalar (GitTimestamp x) = String x++defineClientWithJSON+  "JSON/Custom"+  [gql|+    query TestQuery+      {+        queryTypeName+      }+  |]++resolver :: ByteString -> IO ByteString+resolver = mockApi "JSON/Custom/PartialResponse"++client :: IO (Either (FetchError TestQuery) TestQuery)+client = fetch resolver ()++test :: TestTree+test = testCase "test PartialResponse" $ do+  value <- client+  assertEqual+    "test custom PartialResponse"+    ( Left+        (FetchErrorParseFailure "Error in $.data.queryTypeName: parsing Text failed, expected String, but encountered Number")+    )+    value
+ test/Case/JSON/Custom/PartialResponse/response.json view
@@ -0,0 +1,6 @@+{+  "data": {+    "queryTypeName": 1+  },+  "errors": []+}
test/Case/JSON/Custom/Query.hs view
@@ -19,6 +19,7 @@ import Data.Morpheus.Client   ( EncodeScalar (..),     Fetch (..),+    FetchError,     ScalarValue (..),     gql,   )@@ -64,7 +65,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "JSON/Custom/Query" -client :: IO (Either String TestQuery)+client :: IO (Either (FetchError TestQuery) TestQuery) client = fetch resolver ()  test :: TestTree
test/Case/JSON/Custom/Subscription.hs view
@@ -18,6 +18,7 @@   ) import Data.Morpheus.Client   ( Fetch (..),+    FetchError,     gql,   ) import Data.Text (Text)@@ -52,7 +53,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "JSON/Custom/Subscription" -client :: IO (Either String TestSubscription)+client :: IO (Either (FetchError TestSubscription) TestSubscription) client = fetch resolver ()  test :: TestTree
test/Case/LowercaseTypeName/Test.hs view
@@ -21,6 +21,7 @@   ( DecodeScalar (..),     EncodeScalar (..),     Fetch (..),+    FetchError(..),     ScalarValue (..),     gql,   )@@ -71,7 +72,7 @@ resolver :: ByteString -> IO ByteString resolver = mockApi "LowercaseTypeName" -client :: IO (Either String MyQuery)+client :: IO (Either (FetchError MyQuery) MyQuery) client = fetch resolver ()  testLowercaseTypeName :: TestTree
+ test/Case/Scalar/Test.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Case.Scalar.Test+  ( test,+  )+where++import Data.ByteString.Lazy.Char8+  ( ByteString,+  )+import Data.Morpheus.Client+  ( Fetch (..),+    FetchError(..),+    gql,+  )+import Data.Text (Text)+import Spec.Utils+  ( defineClientWith,+    mockApi,+  )+import Test.Tasty+  ( TestTree,+  )+import Test.Tasty.HUnit+  ( assertEqual,+    testCase,+  )+import Prelude+  ( ($),+    Bool (True),+    Double,+    Either (..),+    IO,+    Int,+    String,+  )++defineClientWith+  "Scalar"+  [gql|+    query MyQuery(+      $inputBolean: Boolean!+      $inputInt: Int!+      $inputFloat: Float!+      $inputString: String!+    ) {+      booleanResolver(booleanValue: $inputBolean)+      intResolver(intValue: $inputInt)+      floatResolver(booleanValue: $inputFloat)+      stringResolver(stringValue: $inputString)+    }+  |]++resolver :: ByteString -> IO ByteString+resolver = mockApi "Scalar"++-- GraphQL Boolean types must be represented with Haskell Bool types+testBoolean :: Bool+testBoolean = True++-- GraphQL Int types must be represented with Haskell Int types+testInt :: Int+testInt = 1242345++-- GraphQL Float types must be represented with Haskell Double types+testFloat :: Double+testFloat = 21233.1234145++-- GraphQL String types must be represented with Haskell Text types+testText :: Text+testText = "Athens"++client :: IO (Either (FetchError MyQuery) MyQuery)+client =+  fetch+    resolver+    MyQueryArgs+      { inputBolean = testBoolean,+        inputInt = testInt,+        inputFloat = testFloat,+        inputString = testText+      }++test :: TestTree+test = testCase "test Scalar" $ do+  value <- client+  assertEqual+    "test Scalar"+    ( Right+        ( MyQuery+            { booleanResolver = testBoolean,+              intResolver = testInt,+              floatResolver = testFloat,+              stringResolver = testText+            }+        )+    )+    value
+ test/Case/Scalar/response.json view
@@ -0,0 +1,8 @@+{+  "data": {+    "booleanResolver": true,+    "intResolver": 1242345,+    "floatResolver": 21233.1234145,+    "stringResolver": "Athens"+  }+}
+ test/Case/Scalar/schema.gql view
@@ -0,0 +1,6 @@+type Query {+  booleanResolver(booleanValue: Boolean!): Boolean!+  intResolver(intValue: Int!): Int!+  floatResolver(booleanValue: Float!): Float!+  stringResolver(stringValue: String!): String!+}
test/Spec.hs view
@@ -8,12 +8,16 @@  import qualified Case.Enum.Test as Enum import Case.Interface.Test (testInterface)+import qualified Case.JSON.Custom.Errors as JSONCustomErrors+import qualified Case.JSON.Custom.NoResponseOrError as JSONNoResponseOrError import qualified Case.JSON.Custom.Mutation as JSONCustomMutation+import qualified Case.JSON.Custom.PartialResponse as JSONCustomPartialResponse import qualified Case.JSON.Custom.Query as JSONCustomQuery import qualified Case.JSON.Custom.Subscription as JSONCustomSubscription import Case.LowercaseTypeName.Test   ( testLowercaseTypeName,   )+import qualified Case.Scalar.Test as Scalar import Test.Tasty   ( defaultMain,     testGroup,@@ -31,7 +35,11 @@       [ testInterface,         testLowercaseTypeName,         Enum.test,+        Scalar.test,+        JSONCustomErrors.test,         JSONCustomMutation.test,+        JSONCustomPartialResponse.test,         JSONCustomQuery.test,-        JSONCustomSubscription.test+        JSONCustomSubscription.test,+        JSONNoResponseOrError.test       ]
test/Spec/Utils.hs view
@@ -18,7 +18,8 @@   ) import Data.Morpheus.Types.Internal.AST   ( ExecutableDocument,-    FieldName (..),+    FieldName,+    unpackName,   ) import Data.Semigroup ((<>)) import qualified Data.Text as T@@ -36,7 +37,7 @@   )  path :: FieldName -> FilePath-path (FieldName name) = "test/Case/" <> T.unpack name+path name = "test/Case/" <> T.unpack (unpackName name)  withProject :: FilePath -> FilePath withProject = ("morpheus-graphql-client/" <>)