packages feed

morpheus-graphql-client (empty) → 0.12.0

raw patch · 11 files changed

+1093/−0 lines, 11 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, morpheus-graphql-core, mtl, template-haskell, text, transformers, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Daviti Nalchevanidze++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,114 @@+# Morpheus GraphQL Client++## Morpheus `GraphQL Client` with Template haskell QuasiQuotes++```hs+defineByDocumentFile+    "./schema.gql"+  [gql|+    query GetHero ($character: Character)+      {+        deity (fatherOf:$character) {+          name+          power+          worships {+            deity2Name: name+          }+        }+      }+  |]+```++with schema:++```gql+input Character {+  name: String!+}++type Deity {+  name: String!+  worships: Deity+  power: Power!+}++enum Power {+  Lightning+  Teleportation+  Omniscience+}+```++will validate query and Generate:++- namespaced response and variable types+- instance for `Fetch` typeClass++```hs+data GetHero = GetHero {+  deity: DeityDeity+}++-- from: {user+data DeityDeity = DeityDeity {+  name: Text,+  worships: Maybe DeityWorshipsDeity+  power: Power+}++-- from: {deity{worships+data DeityWorshipsDeity = DeityWorshipsDeity {+  name: Text,+}++data Power =+    PowerLightning+  | PowerTeleportation+  | PowerOmniscience++data GetHeroArgs = GetHeroArgs {+  getHeroArgsCharacter: Character+}++data Character = Character {+  characterName: Person+}+```++as you see, response type field name collision can be handled with GraphQL `alias`.++with `fetch` you can fetch well typed response `GetHero`.++```haskell+  fetchHero :: Args GetHero -> m (Either String GetHero)+  fetchHero = fetch jsonRes args+      where+        args = GetHeroArgs {getHeroArgsCharacter = Person {characterName = "Zeus"}}+        jsonRes :: ByteString -> m ByteString+        jsonRes = <GraphQL APi>+```++in this case, `jsonRes` resolves a request into a response in some monad `m`.++A `fetch` resolver implementation against [a real API](https://swapi.graph.cool) may look like the following:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Char8 as C8+import Network.HTTP.Req++resolver :: String -> ByteString -> IO ByteString+resolver tok b = runReq defaultHttpConfig $ do+    let headers = header "Content-Type" "application/json"+    responseBody <$> req POST (https "swapi.graph.cool") (ReqBodyLbs b) lbsResponse headers+```++this is demonstrated in examples/src/Client/StarWarsClient.hs++types can be generated from `introspection` too:++```haskell+defineByIntrospectionFile "./introspection.json"+```
+ changelog.md view
@@ -0,0 +1,3 @@+# Changelog++## 0.12.0 - 21.05.2020
+ morpheus-graphql-client.cabal view
@@ -0,0 +1,54 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 8749fc28a63b46eed778a0eb7cfcb2e6f184c7e9c49a7f3a2847b7b735e2599e++name:           morpheus-graphql-client+version:        0.12.0+synopsis:       Morpheus GraphQL Client+description:    Build GraphQL APIs with your favourite functional language!+category:       web, graphql, client+homepage:       https://morpheusgraphql.com+bug-reports:    https://github.com/nalchevanidze/morpheus-graphql/issues+author:         Daviti Nalchevanidze+maintainer:     d.nalchevanidze@gmail.com+copyright:      (c) 2019 Daviti Nalchevanidze+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    changelog.md+    README.md++source-repository head+  type: git+  location: https://github.com/nalchevanidze/morpheus-graphql++library+  exposed-modules:+      Data.Morpheus.Client+  other-modules:+      Data.Morpheus.Client.Aeson+      Data.Morpheus.Client.Build+      Data.Morpheus.Client.Fetch+      Data.Morpheus.Client.Transform.Core+      Data.Morpheus.Client.Transform.Inputs+      Data.Morpheus.Client.Transform.Selection+      Paths_morpheus_graphql_client+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson >=1.4.4.0 && <=1.6+    , base >=4.7 && <5+    , bytestring >=0.10.4 && <0.11+    , morpheus-graphql-core >=0.12.0+    , mtl >=2.0 && <=3.0+    , template-haskell >=2.0 && <=3.0+    , text >=1.2.3.0 && <1.3+    , transformers >=0.3.0.0 && <1.0+    , unordered-containers >=0.2.8.0 && <0.3+  default-language: Haskell2010
+ src/Data/Morpheus/Client.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleContexts #-}++module Data.Morpheus.Client+  ( gql,+    Fetch (..),+    defineQuery,+    defineByDocument,+    defineByDocumentFile,+    defineByIntrospection,+    defineByIntrospectionFile,+  )+where++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as L+  ( readFile,+  )+-- MORPHEUS++import Data.Morpheus.Client.Build+  ( defineQuery,+  )+import Data.Morpheus.Client.Fetch+  ( Fetch (..),+  )+import Data.Morpheus.Core+  ( decodeIntrospection,+    parseFullGQLDocument,+  )+import Data.Morpheus.QuasiQuoter (gql)+import Data.Morpheus.Types.Internal.AST+  ( GQLQuery,+    Schema,+  )+import Data.Morpheus.Types.Internal.Resolving+  ( Eventless,+  )+import Language.Haskell.TH++defineByDocumentFile :: String -> (GQLQuery, String) -> Q [Dec]+defineByDocumentFile = defineByDocument . L.readFile++defineByIntrospectionFile :: String -> (GQLQuery, String) -> Q [Dec]+defineByIntrospectionFile = defineByIntrospection . L.readFile++defineByDocument :: IO ByteString -> (GQLQuery, String) -> Q [Dec]+defineByDocument doc = defineQuery (schemaByDocument doc)++schemaByDocument :: IO ByteString -> IO (Eventless Schema)+schemaByDocument documentGQL = parseFullGQLDocument <$> documentGQL++defineByIntrospection :: IO ByteString -> (GQLQuery, String) -> Q [Dec]+defineByIntrospection json = defineQuery (decodeIntrospection <$> json)
+ src/Data/Morpheus/Client/Aeson.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Morpheus.Client.Aeson+  ( deriveFromJSON,+    deriveToJSON,+    takeValueType,+  )+where++import Data.Aeson+import Data.Aeson.Types+import qualified Data.HashMap.Lazy as H+  ( lookup,+  )+--+-- MORPHEUS+import Data.Morpheus.Internal.TH+  ( destructRecord,+    instanceFunD,+    instanceHeadT,+    mkTypeName,+    nameConE,+    nameLitP,+    nameStringL,+    nameVarE,+    nameVarP,+  )+import Data.Morpheus.Internal.Utils+  ( nameSpaceType,+  )+import Data.Morpheus.Types.Internal.AST+  ( ConsD (..),+    FieldDefinition (..),+    FieldName,+    Message,+    TypeD (..),+    TypeName (..),+    isEnum,+    isFieldNullable,+    msg,+    toFieldName,+  )+import Data.Semigroup ((<>))+import Data.Text+  ( unpack,+  )+import Language.Haskell.TH++failure :: Message -> Q a+failure = fail . show++-- FromJSON+deriveFromJSON :: TypeD -> Q Dec+deriveFromJSON TypeD {tCons = [], tName} =+  failure $ "Type " <> msg tName <> " Should Have at least one Constructor"+deriveFromJSON TypeD {tName, tNamespace, tCons = [cons]} =+  defineFromJSON+    name+    (aesonObject tNamespace)+    cons+  where+    name = nameSpaceType tNamespace tName+deriveFromJSON typeD@TypeD {tName, tCons, tNamespace}+  | isEnum tCons = defineFromJSON name (aesonFromJSONEnumBody tName) tCons+  | otherwise = defineFromJSON name (aesonUnionObject tNamespace) typeD+  where+    name = nameSpaceType tNamespace tName++aesonObject :: [FieldName] -> ConsD -> ExpQ+aesonObject tNamespace con@ConsD {cName} =+  appE+    [|withObject name|]+    (lamE [nameVarP "o"] (aesonObjectBody tNamespace con))+  where+    name = nameSpaceType tNamespace cName++aesonObjectBody :: [FieldName] -> ConsD -> ExpQ+aesonObjectBody namespace ConsD {cName, cFields} = handleFields cFields+  where+    consName = nameConE (nameSpaceType namespace cName)+    ----------------------------------------------------------+    handleFields [] =+      failure $+        "Type \""+          <> msg cName+          <> "\" is Empty Object"+    handleFields fields = startExp fields+      where+        ----------------------------------------------------------++        defField field@FieldDefinition {fieldName}+          | isFieldNullable field = [|o .:? fieldName|]+          | otherwise = [|o .: fieldName|]+        --------------------------------------------------------+        startExp fNames =+          uInfixE+            consName+            (varE '(<$>))+            (applyFields fNames)+          where+            applyFields [] = fail "No Empty fields"+            applyFields [x] = defField x+            applyFields (x : xs) =+              uInfixE (defField x) (varE '(<*>)) (applyFields xs)++aesonUnionObject :: [FieldName] -> TypeD -> ExpQ+aesonUnionObject namespace TypeD {tCons} =+  appE+    (varE 'takeValueType)+    (lamCaseE (map buildMatch tCons <> [elseCaseEXP]))+  where+    buildMatch cons@ConsD {cName} = match objectPattern body []+      where+        objectPattern = tupP [nameLitP cName, nameVarP "o"]+        body = normalB $ aesonObjectBody namespace cons++takeValueType :: ((String, Object) -> Parser a) -> Value -> Parser a+takeValueType f (Object hMap) = case H.lookup "__typename" hMap of+  Nothing -> fail "key \"__typename\" not found on object"+  Just (String x) -> pure (unpack x, hMap) >>= f+  Just val ->+    fail $ "key \"__typename\" should be string but found: " <> show val+takeValueType _ _ = fail "expected Object"++defineFromJSON :: TypeName -> (t -> ExpQ) -> t -> DecQ+defineFromJSON tName parseJ cFields = instanceD (cxt []) iHead [method]+  where+    iHead = instanceHeadT ''FromJSON tName []+    -----------------------------------------+    method = instanceFunD 'parseJSON [] (parseJ cFields)++aesonFromJSONEnumBody :: TypeName -> [ConsD] -> ExpQ+aesonFromJSONEnumBody tName cons = lamCaseE handlers+  where+    handlers = map buildMatch cons <> [elseCaseEXP]+      where+        buildMatch ConsD {cName} = match enumPat body []+          where+            enumPat = nameLitP cName+            body =+              normalB $+                appE+                  (varE 'pure)+                  (nameConE $ nameSpaceType [toFieldName tName] cName)++elseCaseEXP :: MatchQ+elseCaseEXP = match (nameVarP varName) body []+  where+    varName = "invalidValue"+    body =+      normalB $+        appE+          (nameVarE "fail")+          ( uInfixE+              (appE (varE 'show) (nameVarE varName))+              (varE '(<>))+              (stringE " is Not Valid Union Constructor")+          )++aesonToJSONEnumBody :: TypeName -> [ConsD] -> ExpQ+aesonToJSONEnumBody tName cons = lamCaseE handlers+  where+    handlers = map buildMatch cons+      where+        buildMatch ConsD {cName} = match enumPat body []+          where+            enumPat = conP (mkTypeName $ nameSpaceType [toFieldName tName] cName) []+            body = normalB $ litE (nameStringL cName)++-- ToJSON+deriveToJSON :: TypeD -> Q [Dec]+deriveToJSON TypeD {tCons = []} =+  fail "Type Should Have at least one Constructor"+deriveToJSON TypeD {tName, tCons = [ConsD {cFields}]} =+  pure <$> instanceD (cxt []) appHead methods+  where+    appHead = instanceHeadT ''ToJSON tName []+    ------------------------------------------------------------------+    -- defines: toJSON (User field1 field2 ...)= object ["name" .= name, "age" .= age, ...]+    methods = [funD 'toJSON [clause argsE (normalB body) []]]+      where+        argsE = [destructRecord tName varNames]+        body = appE (varE 'object) (listE $ map decodeVar varNames)+        decodeVar name = [|name .= $(varName)|] where varName = nameVarE name+        varNames = map fieldName cFields+deriveToJSON TypeD {tName, tCons}+  | isEnum tCons =+    let methods = [funD 'toJSON clauses]+        clauses = [clause [] (normalB $ aesonToJSONEnumBody tName tCons) []]+     in pure <$> instanceD (cxt []) (instanceHeadT ''ToJSON tName []) methods+  | otherwise =+    fail "Input Unions are not yet supported"
+ src/Data/Morpheus/Client/Build.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Morpheus.Client.Build+  ( defineQuery,+  )+where++--+-- MORPHEUS++import Data.Morpheus.Client.Aeson+  ( deriveFromJSON,+    deriveToJSON,+  )+import Data.Morpheus.Client.Fetch+  ( deriveFetch,+  )+import Data.Morpheus.Client.Transform.Selection+  ( ClientDefinition (..),+    toClientDefinition,+  )+import Data.Morpheus.Core+  ( validateRequest,+  )+import Data.Morpheus.Error+  ( gqlWarnings,+    renderGQLErrors,+  )+import Data.Morpheus.Internal.TH+  ( Scope (..),+    declareType,+    nameConType,+    nameConType,+  )+import qualified Data.Morpheus.Types.Internal.AST as O+  ( Operation (..),+  )+import Data.Morpheus.Types.Internal.AST+  ( DataTypeKind (..),+    GQLQuery (..),+    Schema,+    TypeD (..),+    TypeD (..),+    VALIDATION_MODE (..),+    isOutputObject,+  )+import Data.Morpheus.Types.Internal.Resolving+  ( Eventless,+    Result (..),+  )+import Data.Semigroup ((<>))+import Language.Haskell.TH++defineQuery :: IO (Eventless Schema) -> (GQLQuery, String) -> Q [Dec]+defineQuery ioSchema (query, src) = do+  schema <- runIO ioSchema+  case schema >>= (`validateWith` query) of+    Failure errors -> fail (renderGQLErrors errors)+    Success {result, warnings} -> gqlWarnings warnings >> defineQueryD src result++defineQueryD :: String -> ClientDefinition -> Q [Dec]+defineQueryD _ ClientDefinition {clientTypes = []} = return []+defineQueryD src ClientDefinition {clientArguments, clientTypes = rootType : subTypes} =+  do+    rootDeclaration <-+      defineOperationType+        (queryArgumentType clientArguments)+        src+        rootType+    typeDeclarations <- concat <$> traverse declareT subTypes+    pure (rootDeclaration <> typeDeclarations)+  where+    declareT clientType@TypeD {tKind}+      | isOutputObject tKind || tKind == KindUnion =+        withToJSON+          declareOutputType+          clientType+      | tKind == KindEnum = withToJSON declareInputType clientType+      | otherwise = declareInputType clientType++declareOutputType :: TypeD -> Q [Dec]+declareOutputType typeD = pure [declareType CLIENT False Nothing [''Show] typeD]++declareInputType :: TypeD -> Q [Dec]+declareInputType typeD = do+  toJSONDec <- deriveToJSON typeD+  pure $ declareType CLIENT True Nothing [''Show] typeD : toJSONDec++withToJSON :: (TypeD -> Q [Dec]) -> TypeD -> Q [Dec]+withToJSON f datatype = do+  toJson <- deriveFromJSON datatype+  dec <- f datatype+  pure (toJson : dec)++queryArgumentType :: Maybe TypeD -> (Type, Q [Dec])+queryArgumentType Nothing = (nameConType "()", pure [])+queryArgumentType (Just rootType@TypeD {tName}) =+  (nameConType tName, declareInputType rootType)++defineOperationType :: (Type, Q [Dec]) -> String -> TypeD -> Q [Dec]+defineOperationType (argType, argumentTypes) query clientType =+  do+    rootType <- withToJSON declareOutputType clientType+    typeClassFetch <- deriveFetch argType (tName clientType) query+    argsT <- argumentTypes+    pure $ rootType <> typeClassFetch <> argsT++validateWith :: Schema -> GQLQuery -> Eventless ClientDefinition+validateWith schema rawRequest@GQLQuery {operation} = do+  validOperation <- validateRequest schema WITHOUT_VARIABLES rawRequest+  toClientDefinition+    schema+    (O.operationArguments operation)+    validOperation
+ src/Data/Morpheus/Client/Fetch.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Morpheus.Client.Fetch+  ( Fetch (..),+    deriveFetch,+  )+where++import Control.Monad ((>=>))+import Data.Aeson+  ( FromJSON,+    ToJSON (..),+    eitherDecode,+    encode,+  )+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A+import Data.ByteString.Lazy (ByteString)+--+-- MORPHEUS++import Data.Morpheus.Internal.TH+  ( instanceHeadT,+    nameConType,+    typeInstanceDec,+  )+import Data.Morpheus.Types.IO+  ( GQLRequest (..),+    JSONResponse (..),+  )+import Data.Morpheus.Types.Internal.AST+  ( FieldName,+    TypeName,+  )+import Data.Text+  ( pack,+  )+import Language.Haskell.TH++fixVars :: A.Value -> Maybe A.Value+fixVars x+  | x == A.emptyArray = Nothing+  | otherwise = Just x++class Fetch a where+  type Args a :: *+  __fetch ::+    (Monad m, Show a, ToJSON (Args a), FromJSON a) =>+    String ->+    FieldName ->+    (ByteString -> m ByteString) ->+    Args a ->+    m (Either String a)+  __fetch strQuery opName trans vars = (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)++deriveFetch :: Type -> TypeName -> String -> Q [Dec]+deriveFetch resultType typeName queryString =+  pure <$> instanceD (cxt []) iHead methods+  where+    iHead = instanceHeadT ''Fetch typeName []+    methods =+      [ funD 'fetch [clause [] (normalB [|__fetch queryString typeName|]) []],+        pure $ typeInstanceDec ''Args (nameConType typeName) resultType+      ]
+ src/Data/Morpheus/Client/Transform/Core.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Data.Morpheus.Client.Transform.Core+  ( Converter (..),+    compileError,+    getType,+    leafType,+    typeFrom,+    deprecationWarning,+  )+where++--+-- MORPHEUS+import Control.Monad.Reader (MonadReader, asks)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader+  ( ReaderT (..),+  )+import Data.Morpheus.Error+  ( deprecatedField,+    globalErrorMessage,+  )+import Data.Morpheus.Internal.Utils+  ( Failure (..),+    nameSpaceType,+    selectBy,+  )+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    FieldName,+    GQLErrors,+    Message,+    Meta,+    RAW,+    Ref (..),+    Schema (..),+    TRUE,+    TypeContent (..),+    TypeD,+    TypeDefinition (..),+    TypeName,+    VariableDefinitions,+    lookupDeprecated,+    lookupDeprecatedReason,+    msg,+    typeFromScalar,+  )+import Data.Morpheus.Types.Internal.Resolving+  ( Eventless,+    Result (..),+  )+import Data.Semigroup ((<>))++type Env = (Schema, VariableDefinitions RAW)++newtype Converter a = Converter+  { runConverter ::+      ReaderT+        Env+        Eventless+        a+  }+  deriving (Functor, Applicative, Monad, MonadReader Env)++instance Failure GQLErrors Converter where+  failure = Converter . lift . failure++compileError :: Message -> GQLErrors+compileError x =+  globalErrorMessage $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"++getType :: TypeName -> Converter (TypeDefinition ANY)+getType typename = asks fst >>= selectBy (compileError $ " cant find Type" <> msg typename) typename++leafType :: TypeDefinition a -> Converter ([TypeD], [TypeName])+leafType TypeDefinition {typeName, typeContent} = fromKind typeContent+  where+    fromKind :: TypeContent TRUE a -> Converter ([TypeD], [TypeName])+    fromKind DataEnum {} = pure ([], [typeName])+    fromKind DataScalar {} = pure ([], [])+    fromKind _ = failure $ compileError "Invalid schema Expected scalar"++typeFrom :: [FieldName] -> TypeDefinition a -> TypeName+typeFrom path TypeDefinition {typeName, typeContent} = __typeFrom typeContent+  where+    __typeFrom DataScalar {} = typeFromScalar typeName+    __typeFrom DataObject {} = nameSpaceType path typeName+    __typeFrom DataUnion {} = nameSpaceType path typeName+    __typeFrom _ = typeName++deprecationWarning :: Maybe Meta -> (FieldName, Ref) -> Converter ()+deprecationWarning meta (typename, ref) = case meta >>= lookupDeprecated of+  Just deprecation -> Converter $ lift $ Success {result = (), warnings, events = []}+    where+      warnings =+        deprecatedField+          typename+          ref+          (lookupDeprecatedReason deprecation)+  Nothing -> pure ()
+ src/Data/Morpheus/Client/Transform/Inputs.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Data.Morpheus.Client.Transform.Inputs+  ( renderNonOutputTypes,+    renderOperationArguments,+  )+where++--+-- MORPHEUS+import Control.Monad.Reader (asks)+import Data.Morpheus.Client.Transform.Core (Converter (..), getType, typeFrom)+import Data.Morpheus.Internal.Utils+  ( elems,+  )+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    ArgumentsDefinition (..),+    ConsD (..),+    DataTypeKind (..),+    FieldDefinition (..),+    IN,+    Operation (..),+    RAW,+    TRUE,+    TypeContent (..),+    TypeD (..),+    TypeDefinition (..),+    TypeName,+    TypeRef (..),+    VALID,+    Variable (..),+    VariableDefinitions,+    getOperationName,+    mkConsEnum,+    removeDuplicates,+  )+import Data.Morpheus.Types.Internal.Resolving+  ( resolveUpdates,+  )+import Data.Semigroup ((<>))++renderArguments :: VariableDefinitions RAW -> TypeName -> Maybe TypeD+renderArguments variables argsName+  | null variables = Nothing+  | otherwise = Just rootArgumentsType+  where+    rootArgumentsType :: TypeD+    rootArgumentsType =+      TypeD+        { tName = argsName,+          tNamespace = [],+          tCons = [ConsD {cName = argsName, cFields = map fieldD (elems variables)}],+          tMeta = Nothing,+          tKind = KindInputObject+        }+      where+        fieldD :: Variable RAW -> FieldDefinition ANY+        fieldD Variable {variableName, variableType} =+          FieldDefinition+            { fieldName = variableName,+              fieldArgs = NoArguments,+              fieldType = variableType,+              fieldMeta = Nothing+            }++renderOperationArguments :: Operation VALID -> Converter (Maybe TypeD)+renderOperationArguments Operation {operationName} = do+  variables <- asks snd+  pure $ renderArguments variables (getOperationName operationName <> "Args")++-- INPUTS+renderNonOutputTypes :: [TypeName] -> Converter [TypeD]+renderNonOutputTypes enums = do+  variables <- elems <$> asks snd+  inputTypeRequests <- resolveUpdates [] $ map (exploreInputTypeNames . typeConName . variableType) variables+  concat <$> traverse buildInputType (removeDuplicates $ inputTypeRequests <> enums)++exploreInputTypeNames :: TypeName -> [TypeName] -> Converter [TypeName]+exploreInputTypeNames name collected+  | name `elem` collected = pure collected+  | otherwise = getType name >>= scanInpType+  where+    scanInpType TypeDefinition {typeContent, typeName} = scanType typeContent+      where+        scanType (DataInputObject fields) =+          resolveUpdates+            (name : collected)+            (map toInputTypeD $ elems fields)+          where+            toInputTypeD :: FieldDefinition IN -> [TypeName] -> Converter [TypeName]+            toInputTypeD FieldDefinition {fieldType = TypeRef {typeConName}} =+              exploreInputTypeNames typeConName+        scanType (DataEnum _) = pure (collected <> [typeName])+        scanType _ = pure collected++buildInputType :: TypeName -> Converter [TypeD]+buildInputType name = getType name >>= generateTypes+  where+    generateTypes TypeDefinition {typeName, typeContent} = subTypes typeContent+      where+        subTypes :: TypeContent TRUE ANY -> Converter [TypeD]+        subTypes (DataInputObject inputFields) = do+          fields <- traverse toFieldD (elems inputFields)+          pure+            [ mkInputType+                typeName+                KindInputObject+                [ ConsD+                    { cName = typeName,+                      cFields = fields+                    }+                ]+            ]+        subTypes (DataEnum enumTags) =+          pure+            [ mkInputType+                typeName+                KindEnum+                (map mkConsEnum enumTags)+            ]+        subTypes _ = pure []++mkInputType :: TypeName -> DataTypeKind -> [ConsD] -> TypeD+mkInputType tName tKind tCons =+  TypeD+    { tName,+      tNamespace = [],+      tCons,+      tKind,+      tMeta = Nothing+    }++toFieldD :: FieldDefinition cat -> Converter (FieldDefinition ANY)+toFieldD field@FieldDefinition {fieldType} = do+  typeConName <- typeFrom [] <$> getType (typeConName fieldType)+  pure $ field {fieldType = fieldType {typeConName}}
+ src/Data/Morpheus/Client/Transform/Selection.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Data.Morpheus.Client.Transform.Selection+  ( toClientDefinition,+    ClientDefinition (..),+  )+where++--+-- MORPHEUS+import Control.Monad.Reader (asks, runReaderT)+import Data.Morpheus.Client.Transform.Core (Converter (..), compileError, deprecationWarning, getType, leafType, typeFrom)+import Data.Morpheus.Client.Transform.Inputs (renderNonOutputTypes, renderOperationArguments)+import Data.Morpheus.Internal.Utils+  ( Failure (..),+    elems,+    keyOf,+    selectBy,+  )+import Data.Morpheus.Types.Internal.AST+  ( ANY,+    ArgumentsDefinition (..),+    ConsD (..),+    DataTypeKind (..),+    FieldDefinition (..),+    FieldName,+    Operation (..),+    RAW,+    Ref (..),+    Schema (..),+    Selection (..),+    SelectionContent (..),+    SelectionSet,+    TypeContent (..),+    TypeD (..),+    TypeDefinition (..),+    TypeName,+    TypeRef (..),+    UnionTag (..),+    VALID,+    VariableDefinitions,+    getOperationDataType,+    getOperationName,+    msg,+    toAny,+    toFieldName,+  )+import Data.Morpheus.Types.Internal.Resolving+  ( Eventless,+  )+import Data.Semigroup ((<>))++data ClientDefinition = ClientDefinition+  { clientArguments :: Maybe TypeD,+    clientTypes :: [TypeD]+  }+  deriving (Show)++toClientDefinition ::+  Schema ->+  VariableDefinitions RAW ->+  Operation VALID ->+  Eventless ClientDefinition+toClientDefinition schema vars = flip runReaderT (schema, vars) . runConverter . genOperation++genOperation :: Operation VALID -> Converter ClientDefinition+genOperation operation = do+  (clientArguments, outputTypes, enums) <- renderOperationType operation+  nonOutputTypes <- renderNonOutputTypes enums+  pure ClientDefinition {clientArguments, clientTypes = outputTypes <> nonOutputTypes}++renderOperationType :: Operation VALID -> Converter (Maybe TypeD, [TypeD], [TypeName])+renderOperationType op@Operation {operationName, operationSelection} = do+  datatype <- asks fst >>= getOperationDataType op+  arguments <- renderOperationArguments op+  (outputTypes, enums) <-+    genRecordType+      []+      (getOperationName operationName)+      (toAny datatype)+      operationSelection+  pure (arguments, outputTypes, enums)++-------------------------------------------------------------------------+-- generates selection Object Types+genRecordType ::+  [FieldName] ->+  TypeName ->+  TypeDefinition ANY ->+  SelectionSet VALID ->+  Converter ([TypeD], [TypeName])+genRecordType path tName dataType recordSelSet = do+  (con, subTypes, requests) <- genConsD path tName dataType recordSelSet+  pure+    ( TypeD+        { tName,+          tNamespace = path,+          tCons = [con],+          tKind = KindObject Nothing,+          tMeta = Nothing+        }+        : subTypes,+      requests+    )++genConsD ::+  [FieldName] ->+  TypeName ->+  TypeDefinition ANY ->+  SelectionSet VALID ->+  Converter (ConsD, [TypeD], [TypeName])+genConsD path cName datatype selSet = do+  (cFields, subTypes, requests) <- unzip3 <$> traverse genField (elems selSet)+  pure (ConsD {cName, cFields}, concat subTypes, concat requests)+  where+    genField ::+      Selection VALID ->+      Converter (FieldDefinition ANY, [TypeD], [TypeName])+    genField sel =+      do+        (fieldDataType, fieldType) <-+          getFieldType+            fieldPath+            datatype+            sel+        (subTypes, requests) <- subTypesBySelection fieldPath fieldDataType sel+        pure+          ( FieldDefinition+              { fieldName,+                fieldType,+                fieldArgs = NoArguments,+                fieldMeta = Nothing+              },+            subTypes,+            requests+          )+      where+        fieldPath = path <> [fieldName]+        -------------------------------+        fieldName = keyOf sel++------------------------------------------+subTypesBySelection ::+  [FieldName] ->+  TypeDefinition ANY ->+  Selection VALID ->+  Converter ([TypeD], [TypeName])+subTypesBySelection _ dType Selection {selectionContent = SelectionField} =+  leafType dType+subTypesBySelection path dType Selection {selectionContent = SelectionSet selectionSet} =+  genRecordType path (typeFrom [] dType) dType selectionSet+subTypesBySelection path dType Selection {selectionContent = UnionSelection unionSelections} =+  do+    (tCons, subTypes, requests) <-+      unzip3 <$> traverse getUnionType (elems unionSelections)+    pure+      ( TypeD+          { tNamespace = path,+            tName = typeFrom [] dType,+            tCons,+            tKind = KindUnion,+            tMeta = Nothing+          }+          : concat subTypes,+        concat requests+      )+  where+    getUnionType (UnionTag selectedTyName selectionVariant) = do+      conDatatype <- getType selectedTyName+      genConsD path selectedTyName conDatatype selectionVariant++getFieldType ::+  [FieldName] ->+  TypeDefinition ANY ->+  Selection VALID ->+  Converter (TypeDefinition ANY, TypeRef)+getFieldType+  path+  TypeDefinition {typeContent = DataObject {objectFields}, typeName}+  Selection+    { selectionName,+      selectionPosition+    } =+    selectBy selError selectionName objectFields >>= processDeprecation+    where+      selError = compileError $ "cant find field " <> msg (show objectFields)+      processDeprecation FieldDefinition {fieldType = alias@TypeRef {typeConName}, fieldMeta} =+        checkDeprecated >> (trans <$> getType typeConName)+        where+          trans x =+            (x, alias {typeConName = typeFrom path x, typeArgs = Nothing})+          ------------------------------------------------------------------+          checkDeprecated :: Converter ()+          checkDeprecated =+            deprecationWarning+              fieldMeta+              (toFieldName typeName, Ref {refName = selectionName, refPosition = selectionPosition})+getFieldType _ dt _ =+  failure (compileError $ "Type should be output Object \"" <> msg (show dt))