morpheus-graphql-client 0.22.1 → 0.23.0

raw patch · 29 files changed

+1226/−1136 lines, 29 filesdep +prettyprinterdep ~morpheus-graphql-corePVP ok

version bump matches the API change (PVP)

Dependencies added: prettyprinter

Dependency ranges changed: morpheus-graphql-core

API changes (from Hackage documentation)

Files

• morpheus-graphql-client.cabal +16/−13
• src/Data/Morpheus/Client.hs +7/−2
• src/Data/Morpheus/Client/CodeGen/AST.hs +199/−0
• src/Data/Morpheus/Client/CodeGen/Declare.hs +169/−0
• src/Data/Morpheus/Client/CodeGen/Internal.hs +48/−0
• src/Data/Morpheus/Client/CodeGen/Interpreting/Core.hs +140/−0
• src/Data/Morpheus/Client/CodeGen/Interpreting/Global.hs +79/−0
• src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs +245/−0
• src/Data/Morpheus/Client/CodeGen/Interpreting/PreDeclarations.hs +161/−0
• src/Data/Morpheus/Client/CodeGen/QuasiQuoter.hs +32/−0
• src/Data/Morpheus/Client/CodeGen/TH.hs +37/−0
• src/Data/Morpheus/Client/CodeGen/Utils.hs +54/−0
• src/Data/Morpheus/Client/Declare.hs +0/−151
• src/Data/Morpheus/Client/Fetch.hs +1/−1
• src/Data/Morpheus/Client/Fetch/Http.hs +1/−1
• src/Data/Morpheus/Client/Fetch/RequestType.hs +1/−1
• src/Data/Morpheus/Client/Fetch/ResponseStream.hs +1/−1
• src/Data/Morpheus/Client/Fetch/Types.hs +33/−0
• src/Data/Morpheus/Client/Fetch/WebSockets.hs +1/−1
• src/Data/Morpheus/Client/Internal/TH.hs +0/−149
• src/Data/Morpheus/Client/Internal/Types.hs +0/−68
• src/Data/Morpheus/Client/Internal/Utils.hs +0/−93
• src/Data/Morpheus/Client/Printing/TH.hs +0/−152
• src/Data/Morpheus/Client/QuasiQuoter.hs +0/−32
• src/Data/Morpheus/Client/Schema/Parse.hs +1/−1
• src/Data/Morpheus/Client/Transform.hs +0/−10
• src/Data/Morpheus/Client/Transform/Core.hs +0/−140
• src/Data/Morpheus/Client/Transform/Global.hs +0/−111
• src/Data/Morpheus/Client/Transform/Local.hs +0/−209

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morpheus-graphql-client-version:        0.22.1+version:        0.23.0 synopsis:       Morpheus GraphQL Client description:    Build GraphQL APIs with your favorite functional language! category:       web, graphql, client@@ -55,28 +55,29 @@ library   exposed-modules:       Data.Morpheus.Client+      Data.Morpheus.Client.CodeGen.Internal   other-modules:-      Data.Morpheus.Client.Declare+      Data.Morpheus.Client.CodeGen.AST+      Data.Morpheus.Client.CodeGen.Declare+      Data.Morpheus.Client.CodeGen.Interpreting.Core+      Data.Morpheus.Client.CodeGen.Interpreting.Global+      Data.Morpheus.Client.CodeGen.Interpreting.Local+      Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations+      Data.Morpheus.Client.CodeGen.QuasiQuoter+      Data.Morpheus.Client.CodeGen.TH+      Data.Morpheus.Client.CodeGen.Utils       Data.Morpheus.Client.Fetch       Data.Morpheus.Client.Fetch.GQLClient       Data.Morpheus.Client.Fetch.Http       Data.Morpheus.Client.Fetch.RequestType       Data.Morpheus.Client.Fetch.ResponseStream+      Data.Morpheus.Client.Fetch.Types       Data.Morpheus.Client.Fetch.WebSockets-      Data.Morpheus.Client.Internal.TH-      Data.Morpheus.Client.Internal.Types-      Data.Morpheus.Client.Internal.Utils-      Data.Morpheus.Client.Printing.TH-      Data.Morpheus.Client.QuasiQuoter       Data.Morpheus.Client.Schema.JSON.Parse       Data.Morpheus.Client.Schema.JSON.TypeKind       Data.Morpheus.Client.Schema.JSON.TypeRef       Data.Morpheus.Client.Schema.JSON.Types       Data.Morpheus.Client.Schema.Parse-      Data.Morpheus.Client.Transform-      Data.Morpheus.Client.Transform.Core-      Data.Morpheus.Client.Transform.Global-      Data.Morpheus.Client.Transform.Local       Paths_morpheus_graphql_client   hs-source-dirs:       src@@ -89,9 +90,10 @@     , 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.22.0 && <0.23.0+    , morpheus-graphql-core >=0.23.0 && <0.24.0     , morpheus-graphql-subscriptions     , mtl >=2.0.0 && <3.0.0+    , prettyprinter >=1.7.0 && <2.0.0     , relude >=0.3.0 && <2.0.0     , req >=3.0.0 && <4.0.0     , template-haskell >=2.0.0 && <3.0.0@@ -130,9 +132,10 @@     , modern-uri >=0.1.0.0 && <1.0.0     , morpheus-graphql-client     , morpheus-graphql-code-gen-utils-    , morpheus-graphql-core >=0.22.0 && <0.23.0+    , morpheus-graphql-core >=0.23.0 && <0.24.0     , morpheus-graphql-subscriptions     , mtl >=2.0.0 && <3.0.0+    , prettyprinter >=1.7.0 && <2.0.0     , relude >=0.3.0 && <2.0.0     , req >=3.0.0 && <4.0.0     , tasty >=0.1.0 && <1.5.0

@@ -34,6 +34,9 @@     defineByIntrospection,     defineByIntrospectionFile,     defineByIntrospectionFile',+    parseClientTypeDeclarations,+    readSchemaSource,+    SchemaSource,   ) where @@ -41,15 +44,17 @@ import qualified Data.ByteString.Lazy as L   ( readFile,   )-import Data.Morpheus.Client.Declare+import Data.Morpheus.Client.CodeGen.Declare   ( clientTypeDeclarations,     declareGlobalTypes,     declareGlobalTypesByName,     declareLocalTypes,     declareLocalTypesInline,     internalLegacyLocalDeclareTypes,+    parseClientTypeDeclarations,     raw,   )+import Data.Morpheus.Client.CodeGen.Utils (readSchemaSource) import Data.Morpheus.Client.Fetch   ( Fetch (..),   )@@ -61,7 +66,7 @@     single,     withHeaders,   )-import Data.Morpheus.Client.Internal.Types+import Data.Morpheus.Client.Fetch.Types   ( ExecutableSource,     FetchError (..),     GQLClientResult,

@@ -0,0 +1,199 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.AST+  ( AesonField,+    ClientDeclaration (..),+    ClientMethod (..),+    ClientPreDeclaration (..),+    DERIVING_MODE (..),+    MValue (..),+    Printable (..),+    RequestTypeDefinition (..),+    UnionPat (..),+    ClientTypeDefinition (..),+  )+where++import Data.Foldable (foldr1)+import Data.Morpheus.Client.CodeGen.Internal+  ( takeValueType,+    withObject,+  )+import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenConstructor (..),+    CodeGenType,+    CodeGenTypeName,+    TypeClassInstance,+    printTHName,+  )+import Data.Morpheus.CodeGen.TH+  ( PrintExp (..),+    ToName (toName),+    toCon,+    toString,+    toVar,+    v',+  )+import Data.Morpheus.Types.Internal.AST (FieldName, OperationType, TypeKind, TypeName, unpackName)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax (Lift (..))+import Prettyprinter+  ( Doc,+    Pretty (..),+    indent,+    line,+    list,+    tupled,+    vsep,+    (<+>),+  )+import Relude hiding (lift, show, toString)+import Prelude (show)++data DERIVING_MODE = SCALAR_MODE | ENUM_MODE | TYPE_MODE++data ClientDeclaration+  = InstanceDeclaration (TypeClassInstance ClientMethod)+  | ClientTypeDeclaration CodeGenType++data ClientPreDeclaration+  = ToJSONClass DERIVING_MODE CodeGenType+  | FromJSONClass DERIVING_MODE CodeGenType+  | RequestTypeClass RequestTypeDefinition+  | ClientType CodeGenType++data ClientTypeDefinition = ClientTypeDefinition+  { clientTypeName :: CodeGenTypeName,+    clientCons :: [CodeGenConstructor],+    clientKind :: TypeKind+  }+  deriving (Show)++data RequestTypeDefinition = RequestTypeDefinition+  { requestName :: TypeName,+    requestArgs :: TypeName,+    requestType :: OperationType,+    requestQuery :: String+  }+  deriving (Show)++instance Pretty ClientDeclaration where+  pretty (ClientTypeDeclaration def) = pretty def+  pretty (InstanceDeclaration def) = pretty def++data Printable where+  Printable :: forall a. (Show a, Lift a) => a -> Printable++instance Pretty Printable where+  pretty (Printable x) = pretty (show x :: String)++instance PrintExp Printable where+  printExp (Printable x) = [|x|]++data ClientMethod+  = PrintableMethod Printable+  | FunctionNameMethod Name+  | MatchMethod ValueMatch+  | ToJSONObjectMethod Name [(FieldName, Name, Name)]+  | FromJSONObjectMethod TypeName [AesonField]+  | FromJSONUnionMethod [([UnionPat], (Name, [AesonField]))]++type AesonField = (Name, Name, FieldName)++instance Pretty ClientMethod where+  pretty (FunctionNameMethod x) = printTHName x+  pretty (PrintableMethod x) = pretty x+  pretty (MatchMethod x) = printMatchDoc x+  pretty (ToJSONObjectMethod name fields) = printTHName name <+> indent 2 (line <+> list (map mkEntry fields))+    where+      mkEntry (n, o, v) = prettyLit n <+> printTHName o <+> printTHName v+  pretty (FromJSONObjectMethod name xs) = withBody $ printObjectDoc (toName name, xs)+    where+      withBody body = "withObject" <+> prettyLit name <+> "(\\v ->" <+> body <+> ")"+  pretty (FromJSONUnionMethod xs) = "takeValueType" <+> tupled [matchDoc (map toMatch xs)]+    where+      toMatch (pat, expr) = (tuple $ map mapP pat, printObjectDoc expr)+      mapP (UString v) = prettyLit v+      mapP (UVar v) = pretty v+      tuple ls = "(" <> foldr1 (\a b -> a <> "," <+> b) ls <> ")"++instance PrintExp ClientMethod where+  printExp (FunctionNameMethod v) = varE v+  printExp (PrintableMethod v) = printExp v+  printExp (MatchMethod p) = printMatchExp p+  printExp (ToJSONObjectMethod name fields) = appE (varE name) (listE $ map mkEntry fields)+    where+      mkEntry (n, o, v) = uInfixE (toString n) (toVar o) (toVar v)+  printExp (FromJSONObjectMethod name fields) = withBody $ printObjectExp (toName name, fields)+    where+      withBody body = appE (appE (toVar 'withObject) (toString name)) (lamE [v'] body)+  printExp (FromJSONUnionMethod matches) = appE (toVar 'takeValueType) (matchExp $ map toMatch matches)+    where+      toMatch (pat, expr) = (tupP $ map mapP pat, printObjectExp expr)+      --+      mapP (UString v) = toString v+      mapP (UVar v) = toVar v++printObjectExp :: (Name, [AesonField]) -> ExpQ+printObjectExp (con, fields)+  | null fields = appE [|pure|] (toCon con)+  | otherwise = uInfixE (toCon con) [|(<$>)|] $ foldr1 (\x -> uInfixE x [|(<*>)|]) (map printFieldExp fields)++printObjectDoc :: (Name, [AesonField]) -> Doc n+printObjectDoc (name, fields)+  | null fields = "pure" <+> printTHName name+  | otherwise = printTHName name <+> "<$>" <+> foldr1 (\a b -> a <+> "<*>" <+> b) (map printFieldDoc fields)++printFieldExp :: AesonField -> ExpQ+printFieldExp (v, o, str) = uInfixE (toVar v) (toVar o) (toString str)++printFieldDoc :: AesonField -> Doc n+printFieldDoc (v, o, l) = printTHName v <+> printTHName o <+> prettyLit l++prettyLit :: Show a => a -> Doc ann+prettyLit a = pretty (show a)++prettyName :: TypeName -> Doc ann+prettyName a = pretty (unpackName a :: Text)++data UnionPat+  = UString TypeName+  | UVar String++data MValue+  = MFrom TypeName TypeName+  | MTo TypeName TypeName+  | MFunction String Name++type ValueMatch = [MValue]++printMatchDoc :: ValueMatch -> Doc n+printMatchDoc = matchDoc . map buildMatch+  where+    buildMatch (MFrom a b) = (prettyLit a, "pure" <+> prettyName b)+    buildMatch (MTo a b) = (prettyName a, prettyLit b)+    buildMatch (MFunction v name) = (pretty v, printTHName name <+> pretty v)++printMatchExp :: ValueMatch -> ExpQ+printMatchExp = matchExp . map buildMatch+  where+    buildMatch (MFrom a b) = (toString a, appE (toVar 'pure) (toCon b))+    buildMatch (MTo a b) = (toCon a, toString b)+    buildMatch (MFunction v name) = (toVar v, appE (varE name) v')++matchExp :: [(PatQ, ExpQ)] -> ExpQ+matchExp xs = lamCaseE (map buildMatch xs)+  where+    buildMatch (pat, fb) = match pat (normalB fb) []++matchDoc :: [(Doc n, Doc n)] -> Doc n+matchDoc = ("\\case " <>) . indent 4 . vsep . map buildMatch+  where+    buildMatch (pat, fb) = pat <+> "->" <+> fb

@@ -0,0 +1,169 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Declare+  ( declareGlobalTypes,+    declareGlobalTypesByName,+    declareLocalTypes,+    declareLocalTypesInline,+    internalLegacyLocalDeclareTypes,+    clientTypeDeclarations,+    raw,+    parseClientTypeDeclarations,+  )+where++import Data.Morpheus.Client.CodeGen.AST+  ( ClientDeclaration (..),+  )+import Data.Morpheus.Client.CodeGen.Interpreting.Global+  ( toGlobalDefinitions,+  )+import Data.Morpheus.Client.CodeGen.Interpreting.Local+  ( toLocalDefinitions,+  )+import Data.Morpheus.Client.CodeGen.QuasiQuoter (raw)+import Data.Morpheus.Client.CodeGen.TH+  ( declareIfNotDeclared,+    deriveIfNotDefined,+  )+import Data.Morpheus.Client.CodeGen.Utils (getFile, getSource, handleResult)+import Data.Morpheus.Client.Fetch.Types+  ( ExecutableSource,+    SchemaSource,+  )+import Data.Morpheus.Client.Schema.Parse (parseSchema)+import Data.Morpheus.CodeGen.TH+  ( PrintDec (printDec),+  )+import Data.Morpheus.Core (parseRequest)+import Data.Morpheus.Internal.Ext (GQLResult)+import Data.Morpheus.Types.IO (GQLRequest (..))+import Data.Morpheus.Types.Internal.AST (TypeName)+import qualified Data.Set as S+import Language.Haskell.TH (Dec, Q, runIO)+import Relude++printDeclarations :: [ClientDeclaration] -> Q [Dec]+printDeclarations clientType = concat <$> traverse typeDeclarations clientType++typeDeclarations :: ClientDeclaration -> Q [Dec]+typeDeclarations (InstanceDeclaration dec) = deriveIfNotDefined printDec dec+typeDeclarations (ClientTypeDeclaration c) = declareIfNotDeclared printDec c++internalLegacyLocalDeclareTypes :: IO SchemaSource -> ExecutableSource -> Q [Dec]+internalLegacyLocalDeclareTypes schemaSrc query = do+  schemaText <- runIO schemaSrc+  clientTypeDeclarations schemaText (Just query)++globalTypeDeclarations :: SchemaSource -> (TypeName -> Bool) -> Q [Dec]+globalTypeDeclarations src f = handleResult (parseSchema src >>= toGlobalDefinitions f) printDeclarations++parseClientTypeDeclarations :: SchemaSource -> Maybe Text -> GQLResult [ClientDeclaration]+parseClientTypeDeclarations schemaText (Just query) = do+  schemaDoc <- parseSchema schemaText+  executableDoc <-+    parseRequest+      GQLRequest+        { query,+          operationName = Nothing,+          variables = Nothing+        }+  toLocalDefinitions (query, executableDoc) schemaDoc+parseClientTypeDeclarations src Nothing = parseSchema src >>= toGlobalDefinitions (const True)++-- | declares global or local types, depending+-- on whether the second argument is specified or not+clientTypeDeclarations ::+  SchemaSource ->+  Maybe ExecutableSource ->+  Q [Dec]+clientTypeDeclarations src x = handleResult (parseClientTypeDeclarations src x) printDeclarations++{- ORMOLU_DISABLE -}+-- | declares input, enum and scalar types for specified schema+--+-- Example where the schema is defined in SDL format+--+-- @+-- 'declareGlobalTypes' "schema.gql"+-- @+--+-- Example with schema as introspection in JSON format.+--+-- @+-- 'declareGlobalTypes' "schema.json"+-- @+declareGlobalTypes ::+  FilePath  -- ^ the schema path relative to the  project location,+  -- both introspection (.json) and+  -- schema definition (.gql, .graphql) are accepted.+  -> Q [Dec]+declareGlobalTypes = flip declareClientTypes Nothing+{- ORMOLU_ENABLE -}++-- | declares global types like 'declareGlobalTypes',+-- while enabling to select only the types that are needed.+declareGlobalTypesByName :: FilePath -> [TypeName] -> Q [Dec]+declareGlobalTypesByName path names = do+  schema <- getSource path+  globalTypeDeclarations schema (`S.member` S.fromList names)++{- ORMOLU_DISABLE -}+-- | declares object, interface and union types for+-- specified schema and query.+--+-- Example where the schema is defined in SDL format+--+-- @+-- 'declareLocalTypes' "schema.gql" "query.gql"+-- @+--+-- Example with schema as introspection in JSON format.+--+-- @+-- 'declareLocalTypes' "schema.json" "query.gql"+-- @+declareLocalTypes ::+  FilePath -- ^  the schema path relative to the  project location.+  -- both introspection (`.json`) and+  -- schema definition (`.gql`, `.graphql`) are accepted.+  -> FilePath -- ^ query path relative to the  project location+  -> Q [Dec]+declareLocalTypes schema query = declareClientTypes schema (Just query)+{- ORMOLU_ENABLE -}++{- ORMOLU_DISABLE -}+-- | inline version of `declareLocalTypes`, however+-- instead of specifying the file path, you can simply+-- pass the query as text using QuasiQuoter `raw`+--+-- @+-- `declareLocalTypesInline` "schema.gql"+--     [`raw`|+--        query GetUsers {+--           users {+--             name+--           }+--        }+--     ]+--  @+declareLocalTypesInline ::+  FilePath -- ^ the schema path relative to the  project location.+  -- both introspection (`.json`) and+  -- schema definition (`.gql`, `.graphql`) are accepted.+  -> ExecutableSource -- ^ inline graphql query in Text format+  -> Q [Dec]+declareLocalTypesInline schemaPath query = do+  schema <- getSource schemaPath+  clientTypeDeclarations schema (Just query)+{- ORMOLU_ENABLE -}++declareClientTypes ::+  FilePath ->+  Maybe FilePath ->+  Q [Dec]+declareClientTypes schemaPath queryPath = do+  schema <- getSource schemaPath+  query <- traverse getFile queryPath+  clientTypeDeclarations schema query

@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Internal+  ( FromJSON (..),+    ToJSON (..),+    RequestType (..),+    Generic,+    OperationType (..),+    scalarFromJSON,+    scalarToJSON,+    invalidConstructorError,+    omitNulls,+    (.=),+    withObject,+    (.:),+    (.:?),+    takeValueType,+  )+where++import Data.Aeson (FromJSON (..), Object, ToJSON (..), object, withObject, (.:), (.:?), (.=))+import Data.Aeson.Types (Pair, Parser, Value (..))+import Data.Morpheus.Client.Fetch.RequestType+  ( RequestType (..),+  )+import Data.Morpheus.Internal.Utils (IsMap (lookup))+import Data.Morpheus.Types.GQLScalar (scalarFromJSON, scalarToJSON)+import Data.Morpheus.Types.Internal.AST (OperationType (..))+import qualified Data.Text as T+import Relude++invalidConstructorError :: (MonadFail m, Show a) => a -> m b+invalidConstructorError v = fail $ show v <> " is Not Valid Union Constructor"++takeValueType :: ((String, Object) -> Parser a) -> Value -> Parser a+takeValueType f (Object hMap) = case lookup "__typename" hMap of+  Nothing -> fail "key \"__typename\" not found on object"+  Just (String x) -> f (T.unpack x, hMap)+  Just val ->+    fail $ "key \"__typename\" should be string but found: " <> show val+takeValueType _ _ = fail "expected Object"++omitNulls :: [Pair] -> Value+omitNulls = object . filter notNull+  where+    notNull (_, Null) = False+    notNull _ = True

@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Interpreting.Core+  ( Converter (..),+    compileError,+    getType,+    typeFrom,+    deprecationWarning,+    toCodeGenField,+    toClientDeclarations,+  )+where++import Control.Monad.Except (MonadError)+import Data.Morpheus.Client.CodeGen.AST+  ( ClientPreDeclaration (..),+    ClientTypeDefinition (..),+    DERIVING_MODE (..),+  )+import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenField (..),+    CodeGenType (..),+    DerivingClass (..),+    FIELD_TYPE_WRAPPER (..),+  )+import Data.Morpheus.CodeGen.Utils (camelCaseTypeName)+import Data.Morpheus.Error+  ( deprecatedField,+  )+import Data.Morpheus.Internal.Ext+  ( GQLResult,+    Result (..),+  )+import Data.Morpheus.Internal.Utils+  ( selectBy,+  )+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    Directives,+    FieldDefinition (..),+    FieldName,+    GQLError,+    RAW,+    Ref (..),+    Schema (..),+    TypeContent (..),+    TypeDefinition (..),+    TypeKind (..),+    TypeName,+    TypeRef (..),+    VALID,+    VariableDefinitions,+    internal,+    isNullable,+    isResolverType,+    lookupDeprecated,+    lookupDeprecatedReason,+    msg,+    typeDefinitions,+  )+import Relude++type Env = (Schema VALID, VariableDefinitions RAW)++newtype Converter a = Converter+  { runConverter ::+      ReaderT+        Env+        GQLResult+        a+  }+  deriving+    ( Functor,+      Applicative,+      Monad,+      MonadReader Env,+      MonadError GQLError+    )++compileError :: GQLError -> GQLError+compileError x = internal $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"++getType :: TypeName -> Converter (TypeDefinition ANY VALID)+getType typename =+  asks (typeDefinitions . fst)+    >>= selectBy (compileError $ " can't find Type" <> msg typename) typename++typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName+typeFrom path TypeDefinition {typeName, typeContent} = __typeFrom typeContent+  where+    __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}+    where+      warnings =+        [ deprecatedField+            typename+            ref+            (lookupDeprecatedReason deprecation)+        ]+  Nothing -> pure ()++toCodeGenField :: FieldDefinition a b -> CodeGenField+toCodeGenField FieldDefinition {fieldType = field@TypeRef {..}, ..} =+  CodeGenField+    { fieldName,+      fieldType = typeConName,+      wrappers = [GQL_WRAPPER typeWrappers],+      fieldIsNullable = isNullable field+    }++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]+  | isResolverType clientKind = [ClientType cgType, FromJSONClass TYPE_MODE cgType]+  | otherwise = [ClientType cgType, ToJSONClass TYPE_MODE cgType]+  where+    cgType = printClientType def++printClientType :: ClientTypeDefinition -> CodeGenType+printClientType ClientTypeDefinition {..} =+  CodeGenType+    { cgTypeName = clientTypeName,+      cgConstructors = clientCons,+      cgDerivations = [GENERIC, SHOW, CLASS_EQ]+    }

@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Interpreting.Global+  ( toGlobalDefinitions,+  )+where++import Data.Morpheus.Client.CodeGen.AST+  ( ClientDeclaration,+    ClientTypeDefinition (..),+  )+import Data.Morpheus.Client.CodeGen.Interpreting.Core (toClientDeclarations, toCodeGenField)+import Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations+  ( mapPreDeclarations,+  )+import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenConstructor (..),+    CodeGenTypeName (..),+    fromTypeName,+  )+import Data.Morpheus.Internal.Ext (GQLResult)+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    DataEnumValue (DataEnumValue, enumName),+    Schema (Schema, types),+    TRUE,+    TypeContent (..),+    TypeDefinition (..),+    TypeKind (..),+    TypeName,+    VALID,+    isNotSystemTypeName,+    isResolverType,+  )+import Relude hiding (empty)++toGlobalDefinitions :: (TypeName -> Bool) -> Schema VALID -> GQLResult [ClientDeclaration]+toGlobalDefinitions f Schema {types} =+  traverse mapPreDeclarations $+    concatMap toClientDeclarations $+      mapMaybe generateGlobalType $+        filter shouldInclude (sortWith typeName $ toList types)+  where+    shouldInclude t =+      not (isResolverType t)+        && isNotSystemTypeName (typeName t)+        && f (typeName t)++generateGlobalType :: TypeDefinition ANY VALID -> Maybe ClientTypeDefinition+generateGlobalType TypeDefinition {typeName, typeContent} = do+  (clientKind, clientCons) <- genContent typeContent+  pure+    ClientTypeDefinition+      { clientTypeName = fromTypeName typeName,+        clientKind,+        clientCons+      }+  where+    genContent :: TypeContent TRUE ANY VALID -> Maybe (TypeKind, [CodeGenConstructor])+    genContent (DataInputObject inputFields) =+      pure+        ( KindInputObject,+          [ CodeGenConstructor+              { constructorName = fromTypeName typeName,+                constructorFields = toCodeGenField <$> toList inputFields+              }+          ]+        )+    genContent (DataEnum enumTags) = pure (KindEnum, mkConsEnum typeName <$> enumTags)+    genContent DataScalar {} = pure (KindScalar, [])+    genContent _ = Nothing++mkConsEnum :: TypeName -> DataEnumValue s -> CodeGenConstructor+mkConsEnum typename DataEnumValue {enumName} =+  CodeGenConstructor (CodeGenTypeName [coerce typename] [] enumName) []

@@ -0,0 +1,245 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Interpreting.Local+  ( toLocalDefinitions,+  )+where++import Control.Monad.Except (MonadError (throwError))+import Data.Morpheus.Client.CodeGen.AST+  ( ClientDeclaration,+    ClientPreDeclaration (..),+    ClientTypeDefinition (..),+    RequestTypeDefinition (..),+  )+import Data.Morpheus.Client.CodeGen.Interpreting.Core (Converter (..), compileError, deprecationWarning, getType, toClientDeclarations, toCodeGenField, typeFrom)+import Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations+  ( mapPreDeclarations,+  )+import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenTypeName (..), fromTypeName)+import Data.Morpheus.Core (Config (..), VALIDATION_MODE (WITHOUT_VARIABLES), validateRequest)+import Data.Morpheus.Internal.Ext+  ( GQLResult,+  )+import Data.Morpheus.Internal.Utils+  ( empty,+    keyOf,+    selectBy,+  )+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    ExecutableDocument (..),+    FieldDefinition (..),+    FieldName,+    OUT,+    Operation (..),+    RAW,+    Ref (..),+    Schema (..),+    Selection (..),+    SelectionContent (..),+    SelectionSet,+    TRUE,+    TypeContent (..),+    TypeDefinition (..),+    TypeKind (..),+    TypeName,+    TypeRef (..),+    UnionTag (..),+    VALID,+    Variable (..),+    VariableDefinitions,+    getOperationDataType,+    getOperationName,+    mkTypeRef,+    msg,+    toAny,+  )+import qualified Data.Text as T+import Relude hiding (empty, show)+import Prelude (show)++clientConfig :: Config+clientConfig =+  Config+    { debug = False,+      validationMode = WITHOUT_VARIABLES+    }++toLocalDefinitions :: (Text, ExecutableDocument) -> Schema VALID -> GQLResult [ClientDeclaration]+toLocalDefinitions (query, request) schema = do+  validOperation <- validateRequest clientConfig schema request+  x <- flip runReaderT (schema, operationArguments $ operation request) $ runConverter $ genLocalDeclarations query validOperation+  traverse mapPreDeclarations x++genLocalDeclarations :: Text -> Operation VALID -> Converter [ClientPreDeclaration]+genLocalDeclarations query op@Operation {operationName, operationSelection, operationType} = do+  (schema, varDefs) <- asks id+  datatype <- getOperationDataType op schema+  let argumentsType = toArgumentsType (fromTypeName $ getOperationName operationName <> "Args") varDefs+  (rootType :| localTypes) <-+    genLocalTypes+      []+      (getOperationName operationName)+      (toAny datatype)+      operationSelection+  pure+    ( RequestTypeClass+        RequestTypeDefinition+          { requestArgs = maybe "()" (typename . clientTypeName) argumentsType,+            requestName = typename (clientTypeName rootType),+            requestType = operationType,+            requestQuery = T.unpack query+          }+        : concatMap toClientDeclarations (rootType : (localTypes <> maybeToList argumentsType))+    )++-------------------------------------------------------------------------+-- generates selection Object Types+genLocalTypes ::+  [FieldName] ->+  TypeName ->+  TypeDefinition ANY VALID ->+  SelectionSet VALID ->+  Converter (NonEmpty ClientTypeDefinition)+genLocalTypes namespace tName dataType recordSelSet = do+  let clientTypeName = CodeGenTypeName {namespace, typeParameters = [], typename = tName}+  (con, subTypes) <- toConstructorDefinition (if null namespace then [coerce tName] else namespace) clientTypeName dataType recordSelSet+  pure $+    ClientTypeDefinition+      { clientTypeName,+        clientCons = [con],+        clientKind = KindObject Nothing+      }+      :| subTypes++toConstructorDefinition ::+  [FieldName] ->+  CodeGenTypeName ->+  TypeDefinition ANY VALID ->+  SelectionSet VALID ->+  Converter (CodeGenConstructor, [ClientTypeDefinition])+toConstructorDefinition path name datatype selSet = do+  (fields, subTypes) <- unzip <$> traverse genField (toList selSet)+  pure (CodeGenConstructor {constructorName = name, constructorFields = map toCodeGenField fields}, concat subTypes)+  where+    genField :: Selection VALID -> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])+    genField sel = do+      let fieldName = keyOf sel+      let fieldPath = path <> [fieldName]+      (fieldDataType, fieldType) <- getFieldType fieldPath datatype sel+      subTypes <- subTypesBySelection fieldPath fieldDataType sel+      pure+        ( FieldDefinition+            { fieldName,+              fieldType,+              fieldContent = Nothing,+              fieldDescription = Nothing,+              fieldDirectives = empty+            },+          subTypes+        )++------------------------------------------+subTypesBySelection ::+  [FieldName] ->+  TypeDefinition ANY VALID ->+  Selection VALID ->+  Converter [ClientTypeDefinition]+subTypesBySelection _ _ Selection {selectionContent = SelectionField} = pure []+subTypesBySelection path dType Selection {selectionContent = SelectionSet selectionSet} =+  toList <$> genLocalTypes path (typeFrom [] dType) dType selectionSet+subTypesBySelection namespace dType Selection {selectionContent = UnionSelection interface unionSelections} =+  do+    let variants = UnionTag (typeName dType) interface : toList unionSelections+    (clientCons, subTypes) <- unzip <$> traverse (getVariantType namespace) variants+    pure+      ( ClientTypeDefinition+          { clientTypeName = CodeGenTypeName {namespace, typeParameters = [], typename = typeFrom [] dType},+            clientCons,+            clientKind = KindUnion+          }+          : concat subTypes+      )++getVariantType :: [FieldName] -> UnionTag -> Converter (CodeGenConstructor, [ClientTypeDefinition])+getVariantType path (UnionTag selectedTyName selectionVariant) = do+  conDatatype <- getType selectedTyName+  toConstructorDefinition path (CodeGenTypeName path [] selectedTyName) conDatatype selectionVariant++getFieldType ::+  [FieldName] ->+  TypeDefinition ANY VALID ->+  Selection VALID ->+  Converter (TypeDefinition ANY VALID, TypeRef)+getFieldType+  path+  TypeDefinition {typeContent, typeName}+  Selection+    { selectionName,+      selectionPosition+    } = toFieldDef typeContent >>= processFieldDefinition+    where+      toFieldDef :: TypeContent TRUE ANY VALID -> Converter (FieldDefinition OUT VALID)+      toFieldDef _+        | selectionName == "__typename" =+            pure+              FieldDefinition+                { fieldName = "__typename",+                  fieldDescription = Nothing,+                  fieldType = mkTypeRef "String",+                  fieldDirectives = empty,+                  fieldContent = Nothing+                }+      toFieldDef DataObject {objectFields} = selectBy selError selectionName objectFields+      toFieldDef DataInterface {interfaceFields} = selectBy selError selectionName interfaceFields+      toFieldDef dt = throwError (compileError $ "Type should be output Object \"" <> msg (show dt))+      selError = compileError $ "can't find field " <> msg selectionName <> " on type: " <> msg (show typeContent)+      --+      processFieldDefinition+        FieldDefinition+          { fieldType = TypeRef {..},+            fieldDirectives+          } =+          checkDeprecated *> (trans <$> getType typeConName)+          where+            trans x = (x, TypeRef {typeConName = typeFrom path x, ..})+            ------------------------------------------------------------------+            checkDeprecated :: Converter ()+            checkDeprecated = deprecationWarning fieldDirectives (coerce typeName, Ref selectionName selectionPosition)++toArgumentsType ::+  CodeGenTypeName ->+  VariableDefinitions RAW ->+  Maybe ClientTypeDefinition+toArgumentsType clientTypeName variables+  | null variables = Nothing+  | otherwise =+      Just+        ClientTypeDefinition+          { clientTypeName,+            clientKind = KindInputObject,+            clientCons =+              [ CodeGenConstructor+                  { constructorName = clientTypeName,+                    constructorFields = toCodeGenField . toFieldDefinition <$> toList variables+                  }+              ]+          }++toFieldDefinition :: Variable RAW -> FieldDefinition ANY VALID+toFieldDefinition Variable {variableName, variableType} =+  FieldDefinition+    { fieldName = variableName,+      fieldContent = Nothing,+      fieldType = variableType,+      fieldDescription = Nothing,+      fieldDirectives = empty+    }

@@ -0,0 +1,161 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations+  ( mapPreDeclarations,+  )+where++import Data.Aeson+  ( FromJSON (parseJSON),+    ToJSON (toJSON),+  )+import Data.Aeson.Types ((.:), (.:?), (.=))+import Data.Morpheus.Client.CodeGen.AST+  ( AesonField,+    ClientDeclaration (..),+    ClientMethod (..),+    ClientPreDeclaration (..),+    DERIVING_MODE (..),+    MValue (..),+    Printable (..),+    RequestTypeDefinition (..),+    UnionPat (..),+  )+import Data.Morpheus.Client.CodeGen.Internal (invalidConstructorError, omitNulls)+import Data.Morpheus.Client.Fetch.RequestType+  ( RequestType (..),+  )+import Data.Morpheus.CodeGen.Internal.AST+  ( AssociatedType (AssociatedTypeName),+    CodeGenConstructor (..),+    CodeGenField (..),+    CodeGenType (..),+    CodeGenTypeName (typename),+    MethodArgument (..),+    TypeClassInstance (..),+    fromTypeName,+    getFullName,+  )+import Data.Morpheus.CodeGen.TH+  ( ToName (toName),+  )+import Data.Morpheus.CodeGen.Utils (camelCaseFieldName)+import Data.Morpheus.Types.GQLScalar+  ( scalarFromJSON,+    scalarToJSON,+  )+import Data.Morpheus.Types.Internal.AST (Msg (..), internal)+import Language.Haskell.TH.Syntax (Name)+import Relude hiding (ToString, Type, toString)++mapPreDeclarations :: MonadFail m => ClientPreDeclaration -> m ClientDeclaration+mapPreDeclarations (FromJSONClass mode dec) = InstanceDeclaration <$> deriveFromJSON mode dec+mapPreDeclarations (ToJSONClass mode clientDef) = InstanceDeclaration <$> deriveToJSON mode clientDef+mapPreDeclarations (ClientType c) = pure $ ClientTypeDeclaration c+mapPreDeclarations (RequestTypeClass req) = pure $ InstanceDeclaration (getRequestInstance req)++getRequestInstance :: RequestTypeDefinition -> TypeClassInstance ClientMethod+getRequestInstance RequestTypeDefinition {..} =+  TypeClassInstance+    { typeClassName = ''RequestType,+      typeClassContext = [],+      typeClassTarget = fromTypeName requestName,+      assoc = [(''RequestArgs, AssociatedTypeName $ toName requestArgs)],+      typeClassMethods+    }+  where+    typeClassMethods =+      [ ('__name, ProxyArgument, PrintableMethod $ Printable requestName),+        ('__query, ProxyArgument, PrintableMethod $ Printable requestQuery),+        ('__type, ProxyArgument, PrintableMethod $ Printable requestType)+      ]++-- FromJSON+deriveFromJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m ClientMethod+deriveFromJSONMethod SCALAR_MODE _ = pure $ FunctionNameMethod 'scalarFromJSON+deriveFromJSONMethod _ CodeGenType {cgConstructors = [], ..} = emptyTypeError cgTypeName+deriveFromJSONMethod ENUM_MODE CodeGenType {..} =+  pure $+    MatchMethod $+      map (fromJSONEnum . constructorName) cgConstructors+        <> [MFunction "v" 'invalidConstructorError]+deriveFromJSONMethod _ CodeGenType {cgConstructors = [CodeGenConstructor {..}]} = pure $ FromJSONObjectMethod (getFullName constructorName) (map defField constructorFields)+deriveFromJSONMethod _ CodeGenType {..} = pure $ FromJSONUnionMethod $ map f cgConstructors <> elseCondition+  where+    interfaceConstructor = map genObj (maybeToList $ find ((typename cgTypeName ==) . typename . constructorName) cgConstructors)+    elseCondition = map ([UVar "_", UVar "v"],) interfaceConstructor+    f cons@CodeGenConstructor {..} = ([UString $ typename constructorName, if null constructorFields then UVar "_" else UVar "v"], genObj cons)++genObj :: CodeGenConstructor -> (Name, [AesonField])+genObj CodeGenConstructor {..} = (toName constructorName, map defField constructorFields)++defField :: CodeGenField -> AesonField+defField CodeGenField {..} = (toName ("v" :: String), bindField fieldIsNullable, fieldName)++bindField :: Bool -> Name+bindField nullable+  | nullable = '(.:?)+  | otherwise = '(.:)++deriveToJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod)+deriveToJSONMethod SCALAR_MODE _ = pure (NoArgument, FunctionNameMethod 'scalarToJSON)+deriveToJSONMethod _ CodeGenType {cgConstructors = [], ..} = emptyTypeError cgTypeName+deriveToJSONMethod ENUM_MODE CodeGenType {cgConstructors} =+  pure+    ( NoArgument,+      MatchMethod $ map (toJSONEnum . constructorName) cgConstructors+    )+deriveToJSONMethod _ CodeGenType {cgConstructors = [CodeGenConstructor {..}]} =+  pure+    ( DestructArgument (toName constructorName) (map (\(_, _, v) -> v) entries),+      ToJSONObjectMethod 'omitNulls entries+    )+  where+    entries = map mkEntry constructorFields+    mkEntry CodeGenField {fieldName} =+      ( fieldName,+        '(.=),+        toName $ camelCaseFieldName (getFullName constructorName) fieldName+      )+deriveToJSONMethod _ _ = fail "Input Unions are not yet supported"++toJSONEnum :: CodeGenTypeName -> MValue+toJSONEnum name = MTo (getFullName name) (typename name)++fromJSONEnum :: CodeGenTypeName -> MValue+fromJSONEnum name = MFrom (typename name) (getFullName name)++deriveToJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)+deriveToJSON mode cType = do+  (args, expr) <- deriveToJSONMethod mode cType+  pure+    TypeClassInstance+      { typeClassName = ''ToJSON,+        typeClassContext = [],+        typeClassTarget = cgTypeName cType,+        assoc = [],+        typeClassMethods = [('toJSON, args, expr)]+      }++deriveFromJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod)+deriveFromJSON mode cType = do+  expr <- deriveFromJSONMethod mode cType+  pure+    TypeClassInstance+      { typeClassName = ''FromJSON,+        typeClassContext = [],+        typeClassTarget = cgTypeName cType,+        assoc = [],+        typeClassMethods = [('parseJSON, NoArgument, expr)]+      }++emptyTypeError :: MonadFail m => CodeGenTypeName -> m a+emptyTypeError name = fail $ show $ internal ("Type " <> msg (getFullName name) <> " Should Have at least one Constructor")

@@ -0,0 +1,32 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.QuasiQuoter+  ( raw,+  )+where++import qualified Data.Text as T+import Language.Haskell.TH.Quote+import Relude hiding (ByteString)++notSupported :: Text -> a+notSupported things =+  error $+    things+      <> " are not supported by the GraphQL QuasiQuoter"++-- | QuasiQuoter to insert multiple lines of text in Haskell+raw :: QuasiQuoter+raw =+  QuasiQuoter+    { quoteExp = \txt -> [|T.pack txt|],+      quotePat = notSupported "Patterns",+      quoteType = notSupported "Types",+      quoteDec = notSupported "Declarations"+    }

@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.TH+  ( deriveIfNotDefined,+    declareIfNotDeclared,+  )+where++import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenType (..),+    CodeGenTypeName (..),+    TypeClassInstance (..),+    getFullName,+  )+import Data.Morpheus.CodeGen.TH (toName)+import Language.Haskell.TH+import Relude++isTypeDeclared :: CodeGenTypeName -> Q Bool+isTypeDeclared name = isJust <$> lookupTypeName (toString $ getFullName name)++isInstanceDefined :: Name -> CodeGenTypeName -> Q Bool+isInstanceDefined typeClass tName = do+  exists <- isTypeDeclared tName+  if exists+    then isInstance typeClass [ConT (toName tName)]+    else pure False++deriveIfNotDefined :: (TypeClassInstance a -> Q Dec) -> TypeClassInstance a -> Q [Dec]+deriveIfNotDefined f dec = do+  exists <- isInstanceDefined (typeClassName dec) (typeClassTarget dec)+  traverse f [dec | not exists]++declareIfNotDeclared :: (CodeGenType -> Q a) -> CodeGenType -> Q [a]+declareIfNotDeclared f codeGenType = do+  exists <- isTypeDeclared (cgTypeName codeGenType)+  traverse f [codeGenType | not exists]

@@ -0,0 +1,54 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.CodeGen.Utils+  ( getSource,+    handleResult,+    getFile,+    readSchemaSource,+  )+where++import Control.Monad.Except (MonadError (catchError))+import qualified Data.ByteString.Lazy.Char8 as L+import Data.FileEmbed (makeRelativeToProject)+import Data.List (isSuffixOf)+import Data.Morpheus.Client.Fetch.Types+  ( SchemaSource (..),+  )+import Data.Morpheus.Error (gqlWarnings, renderGQLErrors)+import Data.Morpheus.Internal.Ext (GQLResult, Result (..))+import qualified Data.Text.IO as TIO+import Language.Haskell.TH (Q, runIO)+import Language.Haskell.TH.Syntax (qAddDependentFile)+import Relude++readSchemaSource :: FilePath -> IO SchemaSource+readSchemaSource p+  | ".json" `isSuffixOf` p = JSON <$> L.readFile p+  | ".gql" `isSuffixOf` p || ".graphql" `isSuffixOf` p = GQL <$> L.readFile p+  | otherwise = fail "Unsupported file format! The input should have one of the following extensions: json, gql, graphql"++getSource :: FilePath -> Q SchemaSource+getSource = readWith readSchemaSource++getFile :: FilePath -> Q Text+getFile = readWith TIO.readFile++readWith :: (FilePath -> IO a) -> FilePath -> Q a+readWith f path = do+  p <- makeRelativeToProject path+  qAddDependentFile p+  file <- runIO (catchError ((fmap Right . f) p) (pure . Left . show))+  case file of+    Left x -> fail x+    Right x -> pure x++handleResult :: GQLResult t -> (t -> Q a) -> Q a+handleResult x f = case x of+  Failure errors -> fail (renderGQLErrors errors)+  Success+    { result,+      warnings+    } -> gqlWarnings warnings >> f result

@@ -1,151 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Declare-  ( declareGlobalTypes,-    declareGlobalTypesByName,-    declareLocalTypes,-    declareLocalTypesInline,-    internalLegacyLocalDeclareTypes,-    clientTypeDeclarations,-    raw,-  )-where--import Data.Morpheus.Client.Internal.Types-  ( ExecutableSource,-    SchemaSource,-  )-import Data.Morpheus.Client.Internal.Utils (getFile, getSource, handleResult)-import Data.Morpheus.Client.Printing.TH-  ( printDeclarations,-  )-import Data.Morpheus.Client.QuasiQuoter (raw)-import Data.Morpheus.Client.Schema.Parse (parseSchema)-import Data.Morpheus.Client.Transform-  ( toGlobalDefinitions,-    toLocalDefinitions,-  )-import Data.Morpheus.Core (parseRequest)-import Data.Morpheus.Types.IO (GQLRequest (..))-import Data.Morpheus.Types.Internal.AST (TypeName)-import qualified Data.Set as S-import Language.Haskell.TH (Dec, Q, runIO)-import Relude--internalLegacyLocalDeclareTypes :: IO SchemaSource -> ExecutableSource -> Q [Dec]-internalLegacyLocalDeclareTypes schemaSrc query = do-  schemaText <- runIO schemaSrc-  let request =-        GQLRequest-          { query,-            operationName = Nothing,-            variables = Nothing-          }-  handleResult-    ( do-        schemaDoc <- parseSchema schemaText-        executableDoc <- parseRequest request-        toLocalDefinitions (query, executableDoc) schemaDoc-    )-    printDeclarations--globalTypeDeclarations :: SchemaSource -> (TypeName -> Bool) -> Q [Dec]-globalTypeDeclarations src f = handleResult (toGlobalDefinitions f <$> parseSchema src) printDeclarations---- | declares global or local types, depending--- on whether the second argument is specified or not-clientTypeDeclarations ::-  SchemaSource ->-  Maybe ExecutableSource ->-  Q [Dec]-clientTypeDeclarations src (Just doc) = internalLegacyLocalDeclareTypes (pure src) doc-clientTypeDeclarations src Nothing = globalTypeDeclarations src (const True)--{- ORMOLU_DISABLE -}--- | declares input, enum and scalar types for specified schema------ Example where the schema is defined in SDL format------ @--- 'declareGlobalTypes' "schema.gql"--- @------ Example with schema as introspection in JSON format.------ @--- 'declareGlobalTypes' "schema.json"--- @-declareGlobalTypes ::-  FilePath  -- ^ the schema path relative to the  project location,-  -- both introspection (.json) and-  -- schema definition (.gql, .graphql) are accepted.-  -> Q [Dec]-declareGlobalTypes = flip declareClientTypes Nothing-{- ORMOLU_ENABLE -}---- | declares global types like 'declareGlobalTypes',--- while enabling to select only the types that are needed.-declareGlobalTypesByName :: FilePath -> [TypeName] -> Q [Dec]-declareGlobalTypesByName path names = do-  schema <- getSource path-  globalTypeDeclarations schema (`S.member` S.fromList names)--{- ORMOLU_DISABLE -}--- | declares object, interface and union types for--- specified schema and query.------ Example where the schema is defined in SDL format------ @--- 'declareLocalTypes' "schema.gql" "query.gql"--- @------ Example with schema as introspection in JSON format.------ @--- 'declareLocalTypes' "schema.json" "query.gql"--- @-declareLocalTypes ::-  FilePath -- ^  the schema path relative to the  project location.-  -- both introspection (`.json`) and-  -- schema definition (`.gql`, `.graphql`) are accepted.-  -> FilePath -- ^ query path relative to the  project location-  -> Q [Dec]-declareLocalTypes schema query = declareClientTypes schema (Just query)-{- ORMOLU_ENABLE -}--{- ORMOLU_DISABLE -}--- | inline version of `declareLocalTypes`, however--- instead of specifying the file path, you can simply--- pass the query as text using QuasiQuoter `raw`------ @--- `declareLocalTypesInline` "schema.gql"---     [`raw`|---        query GetUsers {---           users {---             name---           }---        }---     ]---  @-declareLocalTypesInline ::-  FilePath -- ^ the schema path relative to the  project location.-  -- both introspection (`.json`) and-  -- schema definition (`.gql`, `.graphql`) are accepted.-  -> ExecutableSource -- ^ inline graphql query in Text format-  -> Q [Dec]-declareLocalTypesInline schemaPath query = do-  schema <- getSource schemaPath-  clientTypeDeclarations schema (Just query)-{- ORMOLU_ENABLE -}--declareClientTypes ::-  FilePath ->-  Maybe FilePath ->-  Q [Dec]-declareClientTypes schemaPath queryPath = do-  schema <- getSource schemaPath-  query <- traverse getFile queryPath-  clientTypeDeclarations schema query

@@ -23,7 +23,7 @@   ) import Data.ByteString.Lazy (ByteString) import Data.Morpheus.Client.Fetch.RequestType (Request (Request), RequestType (RequestArgs), processResponse, toRequest)-import Data.Morpheus.Client.Internal.Types+import Data.Morpheus.Client.Fetch.Types   ( FetchError (..),   ) import Relude hiding (ByteString)

@@ -18,7 +18,7 @@     decodeResponse,     toRequest,   )-import Data.Morpheus.Client.Internal.Types (GQLClientResult)+import Data.Morpheus.Client.Fetch.Types (GQLClientResult) import qualified Data.Text as T import Network.HTTP.Req   ( POST (..),

@@ -29,7 +29,7 @@ import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import Data.ByteString.Lazy (ByteString)-import Data.Morpheus.Client.Internal.Types+import Data.Morpheus.Client.Fetch.Types   ( FetchError (..),   ) import Data.Morpheus.Client.Schema.JSON.Types

@@ -26,6 +26,7 @@     Request (..),     isSubscription,   )+import Data.Morpheus.Client.Fetch.Types import Data.Morpheus.Client.Fetch.WebSockets   ( endSession,     receiveResponse,@@ -34,7 +35,6 @@     sendRequest,     useWS,   )-import Data.Morpheus.Client.Internal.Types import qualified Data.Text as T import Relude hiding (ByteString) import Text.URI (URI, mkURI)

@@ -0,0 +1,33 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Client.Fetch.Types+  ( FetchError (..),+    SchemaSource (..),+    ExecutableSource,+    GQLClientResult,+  )+where++import Data.ByteString.Lazy (ByteString)+import Data.Morpheus.Types.Internal.AST+  ( GQLErrors,+  )+import Relude hiding (ByteString)++data FetchError a+  = FetchErrorParseFailure String+  | FetchErrorProducedErrors GQLErrors (Maybe a)+  | FetchErrorNoResult+  deriving (Show, Eq, Generic)++data SchemaSource+  = JSON ByteString+  | GQL ByteString+  deriving (Show, Eq)++type ExecutableSource = Text++type GQLClientResult (a :: Type) = (Either (FetchError a) a)

@@ -22,7 +22,7 @@ import qualified Data.Map as M import Data.Morpheus.Client.Fetch.GQLClient (Headers) import Data.Morpheus.Client.Fetch.RequestType (Request, RequestType (..), processResponse, toRequest)-import Data.Morpheus.Client.Internal.Types (FetchError (..), GQLClientResult)+import Data.Morpheus.Client.Fetch.Types (FetchError (..), GQLClientResult) import Data.Morpheus.Client.Schema.JSON.Types (JSONResponse (..)) import Data.Morpheus.Subscriptions.Internal (ApolloSubscription (..)) import qualified Data.Text as T

@@ -1,149 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskellQuotes #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Internal.TH-  ( matchWith,-    decodeObjectE,-    mkFieldsE,-    failExp,-    deriveIfNotDefined,-    declareIfNotDeclared,-  )-where--import Data.Aeson ((.:))-import Data.Aeson.Types ((.:?))-import Data.Foldable (foldr1)-import Data.Morpheus.CodeGen.Internal.AST-  ( CodeGenConstructor (..),-    CodeGenField (..),-    CodeGenType (cgTypeName),-    CodeGenTypeName (..),-    getFullName,-  )-import Data.Morpheus.CodeGen.TH-  ( toCon,-    toName,-    toString,-    toVar,-    v',-  )-import Data.Morpheus.CodeGen.Utils-  ( camelCaseFieldName,-  )-import Language.Haskell.TH-import Relude hiding (toString)--matchWith ::-  Maybe (PatQ, ExpQ) ->-  (t -> (PatQ, ExpQ)) ->-  [t] ->-  ExpQ-matchWith fbexp f xs = lamCaseE (map buildMatch xs <> fallback fbexp)-  where-    fallback (Just (pat, fb)) = [match pat (normalB fb) []]-    fallback _ = []-    buildMatch x = match pat (normalB body) []-      where-        (pat, body) = f x--failExp :: ExpQ-failExp =-  appE-    (toVar 'fail)-    ( uInfixE-        (appE [|show|] v')-        [|(<>)|]-        (stringE " is Not Valid Union Constructor")-    )--decodeObjectE :: CodeGenConstructor -> ExpQ-decodeObjectE CodeGenConstructor {..}-  | null constructorFields = appE [|pure|] (toCon constructorName)-  | otherwise =-      uInfixE-        (toCon constructorName)-        [|(<$>)|]-        (foldr1 withApplicative $ map defField constructorFields)--defField :: CodeGenField -> ExpQ-defField CodeGenField {..} = uInfixE v' (varE $ bindField fieldIsNullable) (toString fieldName)--bindField :: Bool -> Name-bindField nullable-  | nullable = '(.:?)-  | otherwise = '(.:)--withApplicative :: ExpQ -> ExpQ -> ExpQ-withApplicative x = uInfixE x [|(<*>)|]---- | 'mkFieldsE'------  input :---  >>>---       mkFieldsE 'mkValue [FieldDefinition { fieldName = \"field1" ,..} ,..]---  >>>------  expression :---  >>>---    [ mkValue \"field1\" field1,---    ..---    ]--- >>>-mkFieldsE :: CodeGenTypeName -> Name -> [CodeGenField] -> Exp-mkFieldsE conName name = ListE . map (mkEntryWith conName name)----  input : mkFieldWith 'mkValue (FieldDefinition { fieldName = "field1", ..})---  expression: mkValue "field1"  field1-mkEntryWith ::-  CodeGenTypeName ->-  Name ->-  CodeGenField ->-  Exp-mkEntryWith conName f CodeGenField {fieldName} =-  AppE-    (AppE (VarE f) (toString fieldName))-    (toVar $ camelCaseFieldName (getFullName conName) fieldName)--isTypeDeclared :: CodeGenTypeName -> Q Bool-isTypeDeclared clientTypeName = do-  let name = toName clientTypeName-  m <- lookupTypeName (show name)-  case m of-    Nothing -> pure False-    _ -> pure True--hasInstance :: Name -> CodeGenType -> Q Bool-hasInstance typeClass clientDef = isInstance typeClass [ConT (toName (cgTypeName clientDef))]--deriveIfNotDefined :: (CodeGenType -> Q Dec) -> Name -> CodeGenType -> Q [Dec]-deriveIfNotDefined derivation typeClass clientDef = do-  exists <- isTypeDeclared (cgTypeName clientDef)-  if exists-    then do-      has <- hasInstance typeClass clientDef-      if has-        then pure []-        else mkDerivation-    else mkDerivation-  where-    mkDerivation :: Q [Dec]-    mkDerivation = pure <$> derivation clientDef--declareIfNotDeclared :: (CodeGenType -> a) -> CodeGenType -> Q [a]-declareIfNotDeclared f c = do-  exists <- isTypeDeclared (cgTypeName c)-  if exists-    then pure []-    else pure [f c]

@@ -1,68 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Internal.Types-  ( ClientTypeDefinition (..),-    RequestTypeDefinition (..),-    FetchError (..),-    SchemaSource (..),-    ExecutableSource,-    GQLClientResult,-    ClientDeclaration (..),-    DERIVING_MODE (..),-  )-where--import Data.ByteString.Lazy (ByteString)-import Data.Morpheus.CodeGen.Internal.AST-  ( CodeGenConstructor (..),-    CodeGenType,-    CodeGenTypeName,-  )-import Data.Morpheus.Types.Internal.AST-  ( GQLErrors,-    OperationType,-    TypeKind,-    TypeName,-  )-import Relude hiding (ByteString)--data DERIVING_MODE = SCALAR_MODE | ENUM_MODE | TYPE_MODE--data ClientDeclaration-  = ToJSONClass DERIVING_MODE CodeGenType-  | FromJSONClass DERIVING_MODE CodeGenType-  | RequestTypeClass RequestTypeDefinition-  | ClientType CodeGenType--data ClientTypeDefinition = ClientTypeDefinition-  { clientTypeName :: CodeGenTypeName,-    clientCons :: [CodeGenConstructor],-    clientKind :: TypeKind-  }-  deriving (Show)--data RequestTypeDefinition = RequestTypeDefinition-  { requestName :: TypeName,-    requestArgs :: TypeName,-    requestType :: OperationType,-    requestQuery :: String-  }-  deriving (Show)--data FetchError a-  = FetchErrorParseFailure String-  | FetchErrorProducedErrors GQLErrors (Maybe a)-  | FetchErrorNoResult-  deriving (Show, Eq, Generic)--data SchemaSource-  = JSON ByteString-  | GQL ByteString-  deriving (Show, Eq)--type ExecutableSource = Text--type GQLClientResult (a :: Type) = (Either (FetchError a) a)

@@ -1,93 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Internal.Utils-  ( removeDuplicates,-    isEnum,-    getSource,-    handleResult,-    getFile,-    omitNulls,-    emptyTypeError,-    takeValueType,-  )-where--import Control.Monad.Except (MonadError (catchError))-import Data.Aeson (Object)-import Data.Aeson.Types (Pair, Parser, Value (..), object)-import qualified Data.ByteString.Lazy.Char8 as L-import Data.FileEmbed (makeRelativeToProject)-import Data.List (isSuffixOf)-import Data.Morpheus.Client.Internal.Types-  ( SchemaSource (..),-  )-import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenTypeName (..), getFullName)-import Data.Morpheus.Error (gqlWarnings, renderGQLErrors)-import Data.Morpheus.Internal.Ext (GQLResult, Result (..))-import Data.Morpheus.Internal.Utils (IsMap (lookup))-import Data.Morpheus.Types.Internal.AST (Msg (msg), internal)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import Language.Haskell.TH (Q, runIO)-import Language.Haskell.TH.Syntax (qAddDependentFile)-import Relude--removeDuplicates :: Eq a => [a] -> [a]-removeDuplicates = fst . splitDuplicates--splitDuplicates :: Eq a => [a] -> ([a], [a])-splitDuplicates = collectElems ([], [])-  where-    collectElems :: Eq a => ([a], [a]) -> [a] -> ([a], [a])-    collectElems collected [] = collected-    collectElems (collected, errors) (x : xs)-      | x `elem` collected = collectElems (collected, errors <> [x]) xs-      | otherwise = collectElems (collected <> [x], errors) xs--isEnum :: [CodeGenConstructor] -> Bool-isEnum = all (null . constructorFields)--getSource :: FilePath -> Q SchemaSource-getSource p-  | ".json" `isSuffixOf` p = JSON <$> readWith L.readFile p-  | ".gql" `isSuffixOf` p || ".graphql" `isSuffixOf` p = GQL <$> readWith L.readFile p-  | otherwise = fail "Unsupported file format! The input should have one of the following extensions: json, gql, graphql"--getFile :: FilePath -> Q Text-getFile = readWith TIO.readFile--readWith :: (FilePath -> IO a) -> FilePath -> Q a-readWith f path = do-  p <- makeRelativeToProject path-  qAddDependentFile p-  file <- runIO (catchError ((fmap Right . f) p) (pure . Left . show))-  case file of-    Left x -> fail x-    Right x -> pure x--handleResult :: GQLResult t -> (t -> Q a) -> Q a-handleResult x f = case x of-  Failure errors -> fail (renderGQLErrors errors)-  Success-    { result,-      warnings-    } -> gqlWarnings warnings >> f result--omitNulls :: [Pair] -> Value-omitNulls = object . filter notNull-  where-    notNull (_, Null) = False-    notNull _ = True--emptyTypeError :: MonadFail m => CodeGenTypeName -> m a-emptyTypeError name = fail $ show $ internal ("Type " <> msg (getFullName name) <> " Should Have at least one Constructor")--takeValueType :: ((String, Object) -> Parser a) -> Value -> Parser a-takeValueType f (Object hMap) = case lookup "__typename" hMap of-  Nothing -> fail "key \"__typename\" not found on object"-  Just (String x) -> f (T.unpack x, hMap)-  Just val ->-    fail $ "key \"__typename\" should be string but found: " <> show val-takeValueType _ _ = fail "expected Object"

@@ -1,152 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskellQuotes #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Printing.TH-  ( printDeclarations,-  )-where--import Data.Aeson-  ( FromJSON (parseJSON),-    KeyValue ((.=)),-    ToJSON (toJSON),-    withObject,-  )-import Data.Morpheus.Client.Fetch.RequestType-  ( RequestType (..),-  )-import Data.Morpheus.Client.Internal.TH-  ( declareIfNotDeclared,-    decodeObjectE,-    deriveIfNotDefined,-    failExp,-    matchWith,-    mkFieldsE,-  )-import Data.Morpheus.Client.Internal.Types-  ( ClientDeclaration (..),-    DERIVING_MODE (..),-    RequestTypeDefinition (..),-  )-import Data.Morpheus.Client.Internal.Utils-  ( emptyTypeError,-    omitNulls,-    takeValueType,-  )-import Data.Morpheus.CodeGen.Internal.AST-  ( CodeGenConstructor (..),-    CodeGenType (..),-    CodeGenTypeName (..),-    getFullName,-  )-import Data.Morpheus.CodeGen.TH-  ( PrintDec (printDec),-    ToString (..),-    destructConstructor,-    printTypeClass,-    toCon,-    toName,-    toString,-    toVar,-    v',-    _',-  )-import Data.Morpheus.Types.GQLScalar-  ( scalarFromJSON,-    scalarToJSON,-  )-import Data.Morpheus.Types.Internal.AST-  ( TypeName,-  )-import Language.Haskell.TH-  ( Dec,-    DecQ,-    Exp (..),-    ExpQ,-    PatQ,-    Q,-    appE,-    tupP,-  )-import Relude hiding (ToString, toString)--printDeclarations :: [ClientDeclaration] -> Q [Dec]-printDeclarations clientType = concat <$> traverse typeDeclarations clientType--typeDeclarations :: ClientDeclaration -> Q [Dec]-typeDeclarations (FromJSONClass mode clientDef) = deriveIfNotDefined (deriveFromJSON mode) ''FromJSON clientDef-typeDeclarations (ToJSONClass mode clientDef) = deriveIfNotDefined (deriveToJSON mode) ''ToJSON clientDef-typeDeclarations (ClientType c) = declareIfNotDeclared printDec c-typeDeclarations (RequestTypeClass RequestTypeDefinition {..}) =-  pure <$> printTypeClass [] ''RequestType (toCon requestName) [(''RequestArgs, toCon requestArgs)] methods-  where-    methods =-      [ ('__name, [_'], [|requestName|]),-        ('__query, [_'], [|requestQuery|]),-        ('__type, [_'], [|requestType|])-      ]---- UTILS--mkFromJSON :: CodeGenTypeName -> ExpQ -> DecQ-mkFromJSON name expr = printTypeClass [] ''FromJSON (toCon (toName name)) [] [('parseJSON, [], expr)]--mkToJSON :: CodeGenTypeName -> [PatQ] -> ExpQ -> DecQ-mkToJSON name args expr = printTypeClass [] ''ToJSON (toCon $ toName name) [] [('toJSON, args, expr)]--originalLit :: ToString TypeName a => CodeGenTypeName -> Q a-originalLit = toString . typename---- FromJSON-deriveFromJSON :: DERIVING_MODE -> CodeGenType -> DecQ-deriveFromJSON SCALAR_MODE CodeGenType {cgTypeName} = mkFromJSON cgTypeName [|scalarFromJSON|]-deriveFromJSON _ CodeGenType {cgConstructors = [], ..} = emptyTypeError cgTypeName-deriveFromJSON ENUM_MODE CodeGenType {..} =-  mkFromJSON cgTypeName (matchWith (Just (v', failExp)) fromJSONEnum cgConstructors)-deriveFromJSON _ CodeGenType {cgConstructors = [cons], ..} =-  mkFromJSON cgTypeName (fromJSONObject cons)-deriveFromJSON _ typeD@CodeGenType {cgTypeName} =-  mkFromJSON cgTypeName (fromJSONUnion typeD)--fromJSONEnum :: CodeGenConstructor -> (PatQ, ExpQ)-fromJSONEnum CodeGenConstructor {constructorName} = (originalLit constructorName, appE (toVar 'pure) (toCon constructorName))--fromJSONObject :: CodeGenConstructor -> ExpQ-fromJSONObject con@CodeGenConstructor {constructorName} = withBody <$> decodeObjectE con-  where-    withBody body = AppE (AppE (VarE 'withObject) name) (LamE [v'] body)-    name :: Exp-    name = toString (getFullName constructorName)--fromJSONUnion :: CodeGenType -> ExpQ-fromJSONUnion CodeGenType {..} = appE (toVar 'takeValueType) (matchWith elseCondition f cgConstructors)-  where-    elseCondition =-      (tupP [_', v'],) . decodeObjectE-        <$> find ((typename cgTypeName ==) . typename . constructorName) cgConstructors-    f cons@CodeGenConstructor {..} =-      ( tupP [originalLit constructorName, if null constructorFields then _' else v'],-        decodeObjectE cons-      )---- ToJSON-deriveToJSON :: DERIVING_MODE -> CodeGenType -> DecQ-deriveToJSON SCALAR_MODE CodeGenType {..} = mkToJSON cgTypeName [] [|scalarToJSON|]-deriveToJSON _ CodeGenType {cgConstructors = [], ..} = emptyTypeError cgTypeName-deriveToJSON ENUM_MODE CodeGenType {..} =-  mkToJSON cgTypeName [] (matchWith Nothing toJSONEnum cgConstructors)-deriveToJSON _ CodeGenType {cgConstructors = [cons], ..} =-  mkToJSON cgTypeName [destructConstructor cons] (toJSONObject cons)-deriveToJSON _ _ = fail "Input Unions are not yet supported"--toJSONEnum :: CodeGenConstructor -> (PatQ, ExpQ)-toJSONEnum CodeGenConstructor {constructorName} = (toCon constructorName, originalLit constructorName)--toJSONObject :: CodeGenConstructor -> ExpQ-toJSONObject CodeGenConstructor {..} = pure $ AppE (VarE 'omitNulls) (mkFieldsE constructorName '(.=) constructorFields)

@@ -1,32 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskellQuotes #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.QuasiQuoter-  ( raw,-  )-where--import qualified Data.Text as T-import Language.Haskell.TH.Quote-import Relude hiding (ByteString)--notSupported :: Text -> a-notSupported things =-  error $-    things-      <> " are not supported by the GraphQL QuasiQuoter"---- | QuasiQuoter to insert multiple lines of text in Haskell-raw :: QuasiQuoter-raw =-  QuasiQuoter-    { quoteExp = \txt -> [|T.pack txt|],-      quotePat = notSupported "Patterns",-      quoteType = notSupported "Types",-      quoteDec = notSupported "Declarations"-    }

@@ -3,7 +3,7 @@   ) where -import Data.Morpheus.Client.Internal.Types (SchemaSource (..))+import Data.Morpheus.Client.Fetch.Types (SchemaSource (..)) import Data.Morpheus.Client.Schema.JSON.Parse   ( decodeIntrospection,   )

@@ -1,10 +0,0 @@-module Data.Morpheus.Client.Transform-  ( toGlobalDefinitions,-    toLocalDefinitions,-  )-where--import Data.Morpheus.Client.Transform.Global (toGlobalDefinitions)-import Data.Morpheus.Client.Transform.Local-  ( toLocalDefinitions,-  )

@@ -1,140 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Transform.Core-  ( Converter (..),-    compileError,-    getType,-    typeFrom,-    deprecationWarning,-    toCodeGenField,-    toClientDeclarations,-  )-where--import Control.Monad.Except (MonadError)-import Data.Morpheus.Client.Internal.Types-  ( ClientDeclaration (..),-    ClientTypeDefinition (..),-    DERIVING_MODE (..),-  )-import Data.Morpheus.CodeGen.Internal.AST-  ( CodeGenField (..),-    CodeGenType (..),-    DerivingClass (..),-    FIELD_TYPE_WRAPPER (..),-  )-import Data.Morpheus.CodeGen.Utils (camelCaseTypeName)-import Data.Morpheus.Error-  ( deprecatedField,-  )-import Data.Morpheus.Internal.Ext-  ( GQLResult,-    Result (..),-  )-import Data.Morpheus.Internal.Utils-  ( selectBy,-  )-import Data.Morpheus.Types.Internal.AST-  ( ANY,-    Directives,-    FieldDefinition (..),-    FieldName,-    GQLError,-    RAW,-    Ref (..),-    Schema (..),-    TypeContent (..),-    TypeDefinition (..),-    TypeKind (..),-    TypeName,-    TypeRef (..),-    VALID,-    VariableDefinitions,-    internal,-    isNullable,-    isResolverType,-    lookupDeprecated,-    lookupDeprecatedReason,-    msg,-    typeDefinitions,-  )-import Relude--type Env = (Schema VALID, VariableDefinitions RAW)--newtype Converter a = Converter-  { runConverter ::-      ReaderT-        Env-        GQLResult-        a-  }-  deriving-    ( Functor,-      Applicative,-      Monad,-      MonadReader Env,-      MonadError GQLError-    )--compileError :: GQLError -> GQLError-compileError x = internal $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"--getType :: TypeName -> Converter (TypeDefinition ANY VALID)-getType typename =-  asks (typeDefinitions . fst)-    >>= selectBy (compileError $ " can't find Type" <> msg typename) typename--typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName-typeFrom path TypeDefinition {typeName, typeContent} = __typeFrom typeContent-  where-    __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}-    where-      warnings =-        [ deprecatedField-            typename-            ref-            (lookupDeprecatedReason deprecation)-        ]-  Nothing -> pure ()--toCodeGenField :: FieldDefinition a b -> CodeGenField-toCodeGenField FieldDefinition {fieldType = field@TypeRef {..}, ..} =-  CodeGenField-    { fieldName,-      fieldType = typeConName,-      wrappers = [GQL_WRAPPER typeWrappers],-      fieldIsNullable = isNullable field-    }--toClientDeclarations :: ClientTypeDefinition -> [ClientDeclaration]-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]-  | isResolverType clientKind = [ClientType cgType, FromJSONClass TYPE_MODE cgType]-  | otherwise = [ClientType cgType, ToJSONClass TYPE_MODE cgType]-  where-    cgType = printClientType def--printClientType :: ClientTypeDefinition -> CodeGenType-printClientType ClientTypeDefinition {..} =-  CodeGenType-    { cgTypeName = clientTypeName,-      cgConstructors = clientCons,-      cgDerivations = [GENERIC, SHOW, CLASS_EQ]-    }

@@ -1,111 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Transform.Global-  ( toArgumentsType,-    toGlobalDefinitions,-  )-where--import Data.Morpheus.Client.Internal.Types-  ( ClientDeclaration,-    ClientTypeDefinition (..),-  )-import Data.Morpheus.Client.Transform.Core (toClientDeclarations, toCodeGenField)-import Data.Morpheus.CodeGen.Internal.AST-  ( CodeGenConstructor (..),-    CodeGenTypeName (..),-    fromTypeName,-  )-import Data.Morpheus.Internal.Utils-  ( empty,-  )-import Data.Morpheus.Types.Internal.AST-  ( ANY,-    DataEnumValue (DataEnumValue, enumName),-    FieldDefinition (..),-    RAW,-    Schema (Schema, types),-    TRUE,-    TypeContent (..),-    TypeDefinition (..),-    TypeKind (..),-    TypeName,-    VALID,-    Variable (..),-    VariableDefinitions,-    isNotSystemTypeName,-    isResolverType,-  )-import Relude hiding (empty)--toArgumentsType ::-  CodeGenTypeName ->-  VariableDefinitions RAW ->-  Maybe ClientTypeDefinition-toArgumentsType clientTypeName variables-  | null variables = Nothing-  | otherwise =-      Just-        ClientTypeDefinition-          { clientTypeName,-            clientKind = KindInputObject,-            clientCons =-              [ CodeGenConstructor-                  { constructorName = clientTypeName,-                    constructorFields = toCodeGenField . toFieldDefinition <$> toList variables-                  }-              ]-          }--toFieldDefinition :: Variable RAW -> FieldDefinition ANY VALID-toFieldDefinition Variable {variableName, variableType} =-  FieldDefinition-    { fieldName = variableName,-      fieldContent = Nothing,-      fieldType = variableType,-      fieldDescription = Nothing,-      fieldDirectives = empty-    }--toGlobalDefinitions :: (TypeName -> Bool) -> Schema VALID -> [ClientDeclaration]-toGlobalDefinitions f Schema {types} =-  concatMap toClientDeclarations $-    mapMaybe generateGlobalType $-      filter shouldInclude (toList types)-  where-    shouldInclude t =-      not (isResolverType t)-        && isNotSystemTypeName (typeName t)-        && f (typeName t)--generateGlobalType :: TypeDefinition ANY VALID -> Maybe ClientTypeDefinition-generateGlobalType TypeDefinition {typeName, typeContent} = do-  (clientKind, clientCons) <- genContent typeContent-  pure-    ClientTypeDefinition-      { clientTypeName = fromTypeName typeName,-        clientKind,-        clientCons-      }-  where-    genContent :: TypeContent TRUE ANY VALID -> Maybe (TypeKind, [CodeGenConstructor])-    genContent (DataInputObject inputFields) =-      pure-        ( KindInputObject,-          [ CodeGenConstructor-              { constructorName = fromTypeName typeName,-                constructorFields = toCodeGenField <$> toList inputFields-              }-          ]-        )-    genContent (DataEnum enumTags) = pure (KindEnum, mkConsEnum typeName <$> enumTags)-    genContent DataScalar {} = pure (KindScalar, [])-    genContent _ = Nothing--mkConsEnum :: TypeName -> DataEnumValue s -> CodeGenConstructor-mkConsEnum typename DataEnumValue {enumName} =-  CodeGenConstructor (CodeGenTypeName [coerce typename] [] enumName) []

@@ -1,209 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Morpheus.Client.Transform.Local-  ( toLocalDefinitions,-  )-where--import Control.Monad.Except (MonadError (throwError))-import Data.Morpheus.Client.Internal.Types-  ( ClientDeclaration (..),-    ClientTypeDefinition (..),-    RequestTypeDefinition (..),-  )-import Data.Morpheus.Client.Transform.Core (Converter (..), compileError, deprecationWarning, getType, toClientDeclarations, toCodeGenField, typeFrom)-import Data.Morpheus.Client.Transform.Global (toArgumentsType)-import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenTypeName (..), fromTypeName)-import Data.Morpheus.Core (Config (..), VALIDATION_MODE (WITHOUT_VARIABLES), validateRequest)-import Data.Morpheus.Internal.Ext-  ( GQLResult,-  )-import Data.Morpheus.Internal.Utils-  ( empty,-    keyOf,-    selectBy,-  )-import Data.Morpheus.Types.Internal.AST-  ( ANY,-    ExecutableDocument (..),-    FieldDefinition (..),-    FieldName,-    OUT,-    Operation (..),-    Ref (..),-    Schema (..),-    Selection (..),-    SelectionContent (..),-    SelectionSet,-    TRUE,-    TypeContent (..),-    TypeDefinition (..),-    TypeKind (..),-    TypeName,-    TypeRef (..),-    UnionTag (..),-    VALID,-    getOperationDataType,-    getOperationName,-    mkTypeRef,-    msg,-    toAny,-  )-import qualified Data.Text as T-import Relude hiding (empty, show)-import Prelude (show)--clientConfig :: Config-clientConfig =-  Config-    { debug = False,-      validationMode = WITHOUT_VARIABLES-    }--toLocalDefinitions :: (Text, ExecutableDocument) -> Schema VALID -> GQLResult [ClientDeclaration]-toLocalDefinitions (query, request) schema = do-  validOperation <- validateRequest clientConfig schema request-  flip runReaderT (schema, operationArguments $ operation request) $ runConverter $ genLocalDeclarations query validOperation--genLocalDeclarations :: Text -> Operation VALID -> Converter [ClientDeclaration]-genLocalDeclarations query op@Operation {operationName, operationSelection, operationType} = do-  (schema, varDefs) <- asks id-  datatype <- getOperationDataType op schema-  let argumentsType = toArgumentsType (fromTypeName $ getOperationName operationName <> "Args") varDefs-  (rootType :| localTypes) <--    genLocalTypes-      []-      (getOperationName operationName)-      (toAny datatype)-      operationSelection-  pure-    ( RequestTypeClass-        RequestTypeDefinition-          { requestArgs = maybe "()" (typename . clientTypeName) argumentsType,-            requestName = typename (clientTypeName rootType),-            requestType = operationType,-            requestQuery = T.unpack query-          }-        : concatMap toClientDeclarations (rootType : (localTypes <> maybeToList argumentsType))-    )------------------------------------------------------------------------------ generates selection Object Types-genLocalTypes ::-  [FieldName] ->-  TypeName ->-  TypeDefinition ANY VALID ->-  SelectionSet VALID ->-  Converter (NonEmpty ClientTypeDefinition)-genLocalTypes namespace tName dataType recordSelSet = do-  let clientTypeName = CodeGenTypeName {namespace, typeParameters = [], typename = tName}-  (con, subTypes) <- toConstructorDefinition (if null namespace then [coerce tName] else namespace) clientTypeName dataType recordSelSet-  pure $-    ClientTypeDefinition-      { clientTypeName,-        clientCons = [con],-        clientKind = KindObject Nothing-      }-      :| subTypes--toConstructorDefinition ::-  [FieldName] ->-  CodeGenTypeName ->-  TypeDefinition ANY VALID ->-  SelectionSet VALID ->-  Converter (CodeGenConstructor, [ClientTypeDefinition])-toConstructorDefinition path name datatype selSet = do-  (fields, subTypes) <- unzip <$> traverse genField (toList selSet)-  pure (CodeGenConstructor {constructorName = name, constructorFields = map toCodeGenField fields}, concat subTypes)-  where-    genField :: Selection VALID -> Converter (FieldDefinition ANY VALID, [ClientTypeDefinition])-    genField sel = do-      let fieldName = keyOf sel-      let fieldPath = path <> [fieldName]-      (fieldDataType, fieldType) <- getFieldType fieldPath datatype sel-      subTypes <- subTypesBySelection fieldPath fieldDataType sel-      pure-        ( FieldDefinition-            { fieldName,-              fieldType,-              fieldContent = Nothing,-              fieldDescription = Nothing,-              fieldDirectives = empty-            },-          subTypes-        )---------------------------------------------subTypesBySelection ::-  [FieldName] ->-  TypeDefinition ANY VALID ->-  Selection VALID ->-  Converter [ClientTypeDefinition]-subTypesBySelection _ _ Selection {selectionContent = SelectionField} = pure []-subTypesBySelection path dType Selection {selectionContent = SelectionSet selectionSet} =-  toList <$> genLocalTypes path (typeFrom [] dType) dType selectionSet-subTypesBySelection namespace dType Selection {selectionContent = UnionSelection interface unionSelections} =-  do-    let variants = UnionTag (typeName dType) interface : toList unionSelections-    (clientCons, subTypes) <- unzip <$> traverse (getVariantType namespace) variants-    pure-      ( ClientTypeDefinition-          { clientTypeName = CodeGenTypeName {namespace, typeParameters = [], typename = typeFrom [] dType},-            clientCons,-            clientKind = KindUnion-          }-          : concat subTypes-      )--getVariantType :: [FieldName] -> UnionTag -> Converter (CodeGenConstructor, [ClientTypeDefinition])-getVariantType path (UnionTag selectedTyName selectionVariant) = do-  conDatatype <- getType selectedTyName-  toConstructorDefinition path (CodeGenTypeName path [] selectedTyName) conDatatype selectionVariant--getFieldType ::-  [FieldName] ->-  TypeDefinition ANY VALID ->-  Selection VALID ->-  Converter (TypeDefinition ANY VALID, TypeRef)-getFieldType-  path-  TypeDefinition {typeContent, typeName}-  Selection-    { selectionName,-      selectionPosition-    } = toFieldDef typeContent >>= processFieldDefinition-    where-      toFieldDef :: TypeContent TRUE ANY VALID -> Converter (FieldDefinition OUT VALID)-      toFieldDef _-        | selectionName == "__typename" =-            pure-              FieldDefinition-                { fieldName = "__typename",-                  fieldDescription = Nothing,-                  fieldType = mkTypeRef "String",-                  fieldDirectives = empty,-                  fieldContent = Nothing-                }-      toFieldDef DataObject {objectFields} = selectBy selError selectionName objectFields-      toFieldDef DataInterface {interfaceFields} = selectBy selError selectionName interfaceFields-      toFieldDef dt = throwError (compileError $ "Type should be output Object \"" <> msg (show dt))-      selError = compileError $ "can't find field " <> msg selectionName <> " on type: " <> msg (show typeContent)-      ---      processFieldDefinition-        FieldDefinition-          { fieldType = TypeRef {..},-            fieldDirectives-          } =-          checkDeprecated *> (trans <$> getType typeConName)-          where-            trans x = (x, TypeRef {typeConName = typeFrom path x, ..})-            -------------------------------------------------------------------            checkDeprecated :: Converter ()-            checkDeprecated = deprecationWarning fieldDirectives (coerce typeName, Ref selectionName selectionPosition)