packages feed

morpheus-graphql-code-gen-utils (empty) → 0.22.0

raw patch · 9 files changed

+866/−0 lines, 9 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, morpheus-graphql-core, prettyprinter, relude, template-haskell, text, 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,76 @@+# Morpheus GraphQL Code Gen++Morpheus GraphQL Code Gen helps you to generate GraphQL APIs .++Morpheus GraphQL CLI is still in an early stage of development, so any feedback is more than welcome, and we appreciate any contribution!+Just open an issue here on GitHub, or join [our Slack channel](https://morpheus-graphql-slack-invite.herokuapp.com/) to get in touch.++## Getting Started++Generating dummy Morpheus Api from `schema.gql`++```ssh+morpheus build src/*.gql --root src+```++_src/schema.gql_++```gql+type Query {+  deity(name: String!): Deity+  deities: [Deity!]!+}++"""+deity description+"""+type Deity {+  """+  name description+  """+  name: String!+  power: String+}+```++_src/Schema.hs_++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module Schema where++import Data.Data (Typeable)+import Data.Map (empty, fromList)+import Data.Morpheus.Kind (TYPE)+import Data.Morpheus.Types+import Data.Text (Text)+import GHC.Generics (Generic)++---- GQL Query -------------------------------+data Query m = Query+  { queryDeity :: Arg "name" Text -> m (Maybe (Deity m)),+    queryDeities :: m [Deity m]+  }+  deriving (Generic)++instance (Typeable m) => GQLType (Query m) where+  type KIND (Query m) = TYPE++---- GQL Deity -------------------------------+data Deity m = Deity+  { deityName :: m Text,+    deityPower :: m (Maybe Text)+  }+  deriving (Generic)++instance (Typeable m) => GQLType (Deity m) where+  type KIND (Deity m) = TYPE+  description _ = Just "\ndeity description\n"+  getDescriptions _ = fromList [("name", "\n  name description\n  ")]+```
+ changelog.md view
@@ -0,0 +1,3 @@+# Changelog++see latest changes on [Github](https://github.com/morpheusgraphql/morpheus-graphql/releases)
+ morpheus-graphql-code-gen-utils.cabal view
@@ -0,0 +1,50 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name:           morpheus-graphql-code-gen-utils+version:        0.22.0+synopsis:       Morpheus GraphQL CLI+description:    code generator for Morpheus GraphQL+category:       web, graphql, cli+homepage:       https://morpheusgraphql.com+bug-reports:    https://github.com/morpheusgraphql/morpheus-graphql/issues+author:         Daviti Nalchevanidze+maintainer:     d.nalchevanidze@gmail.com+copyright:      (c) 2019 Daviti Nalchevanidze+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    changelog.md++source-repository head+  type: git+  location: https://github.com/morpheusgraphql/morpheus-graphql++library+  exposed-modules:+      Data.Morpheus.CodeGen.Internal.AST+      Data.Morpheus.CodeGen.Printer+      Data.Morpheus.CodeGen.TH+      Data.Morpheus.CodeGen.Utils+  other-modules:+      Data.Morpheus.CodeGen.Internal.Name+      Paths_morpheus_graphql_code_gen_utils+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7.0 && <5.0.0+    , bytestring >=0.10.4 && <0.12.0+    , containers >=0.4.2.1 && <0.7.0+    , morpheus-graphql-core >=0.22.0 && <0.23.0+    , prettyprinter >=1.7.0 && <2.0.0+    , relude >=0.3.0 && <2.0.0+    , template-haskell >=2.0.0 && <3.0.0+    , text >=1.2.3 && <1.3.0+    , unordered-containers >=0.2.8 && <0.3.0+  default-language: Haskell2010
+ src/Data/Morpheus/CodeGen/Internal/AST.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenConstructor (..),+    CodeGenField (..),+    CodeGenType (..),+    CodeGenTypeName (..),+    DerivingClass (..),+    FIELD_TYPE_WRAPPER (..),+    TypeValue (..),+    fromTypeName,+    getFullName,+  )+where++import Data.Morpheus.CodeGen.Internal.Name (camelCaseTypeName)+import Data.Morpheus.CodeGen.Printer+import Data.Morpheus.Types.Internal.AST+  ( FieldName,+    TypeName,+    TypeRef,+    TypeWrapper,+    unpackName,+  )+import qualified Language.Haskell.TH.Syntax as TH+import Prettyprinter+  ( Doc,+    Pretty (..),+    comma,+    enclose,+    hsep,+    indent,+    line,+    nest,+    pretty,+    punctuate,+    tupled,+    vsep,+    (<+>),+  )+import Relude hiding (print)++data DerivingClass+  = SHOW+  | GENERIC+  | CLASS_EQ+  deriving (Show)++instance Pretty DerivingClass where+  pretty SHOW = "Show"+  pretty GENERIC = "Generic"+  pretty CLASS_EQ = "Eq"++data TypeValue+  = TypeValueObject TypeName [(FieldName, TypeValue)]+  | TypeValueNumber Double+  | TypeValueString Text+  | TypeValueBool Bool+  | TypeValueList [TypeValue]+  | TypedValueMaybe (Maybe TypeValue)+  deriving (Show)++renderField :: (FieldName, TypeValue) -> Doc n+renderField (fName, fValue) = pretty (unpackName fName :: Text) <> "=" <+> pretty fValue++instance Pretty TypeValue where+  pretty (TypeValueObject name xs) =+    pretty (unpackName name :: Text)+      <+> "{"+      <+> vsep (punctuate "," (map renderField xs))+      <+> "}"+  pretty (TypeValueNumber x) = pretty x+  pretty (TypeValueString x) = pretty (show x :: String)+  pretty (TypeValueBool x) = pretty x+  pretty (TypedValueMaybe (Just x)) = "Just" <+> pretty x+  pretty (TypedValueMaybe Nothing) = "Nothing"+  pretty (TypeValueList xs) = prettyList xs++data CodeGenType = CodeGenType+  { cgTypeName :: CodeGenTypeName,+    cgConstructors :: [CodeGenConstructor],+    cgDerivations :: [DerivingClass]+  }+  deriving (Show)++instance Pretty CodeGenType where+  pretty CodeGenType {..} =+    "data"+      <+> ignore (print cgTypeName)+        <> renderConstructors cgConstructors+        <> line+        <> indent 2 (renderDeriving cgDerivations)+        <> line+    where+      renderConstructors [cons] = (" =" <+>) $ print' cons+      renderConstructors conses = nest 2 . (line <>) . vsep . prefixVariants $ map print' conses+      prefixVariants (x : xs) = "=" <+> x : map ("|" <+>) xs+      prefixVariants [] = []++renderDeriving :: [DerivingClass] -> Doc n+renderDeriving = ("deriving" <+>) . tupled . map pretty++data CodeGenConstructor = CodeGenConstructor+  { constructorName :: CodeGenTypeName,+    constructorFields :: [CodeGenField]+  }+  deriving (Show)++instance Printer CodeGenConstructor where+  print CodeGenConstructor {constructorFields = [], ..} =+    print constructorName+  print CodeGenConstructor {..} = do+    let fields = map (unpack . print) constructorFields+    pack (print' constructorName <> renderSet fields)+    where+      renderSet = nest 2 . enclose "\n{ " "\n}" . nest 2 . vsep . punctuate comma++data CodeGenField = CodeGenField+  { fieldName :: FieldName,+    fieldType :: TypeName,+    wrappers :: [FIELD_TYPE_WRAPPER],+    fieldIsNullable :: Bool+  }+  deriving (Show)++instance Printer CodeGenField where+  print CodeGenField {..} = infix' (print fieldName) "::" (foldr renderWrapper (print fieldType) wrappers)++data FIELD_TYPE_WRAPPER+  = MONAD+  | SUBSCRIPTION TH.Name+  | PARAMETRIZED+  | ARG TypeName+  | TAGGED_ARG TH.Name FieldName TypeRef+  | GQL_WRAPPER TypeWrapper+  deriving (Show)++renderWrapper :: FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n+renderWrapper PARAMETRIZED = (.<> "m")+renderWrapper MONAD = ("m" .<>)+renderWrapper SUBSCRIPTION {} = id+renderWrapper (GQL_WRAPPER typeWrappers) = wrapped typeWrappers+renderWrapper (ARG name) = infix' (print name) "->"+renderWrapper (TAGGED_ARG _ name typeRef) = infix' (apply "Arg" [print (show name :: String), print typeRef]) "->"++data CodeGenTypeName = CodeGenTypeName+  { namespace :: [FieldName],+    typeParameters :: [Text],+    typename :: TypeName+  }+  deriving (Show)++getFullName :: CodeGenTypeName -> TypeName+getFullName CodeGenTypeName {..} = camelCaseTypeName namespace typename++fromTypeName :: TypeName -> CodeGenTypeName+fromTypeName = CodeGenTypeName [] []++instance Printer CodeGenTypeName where+  print cgName =+    HSDoc (not $ null (typeParameters cgName)) $+      parametrizedType+        (unpackName (getFullName cgName))+        (typeParameters cgName)++parametrizedType :: Text -> [Text] -> Doc ann+parametrizedType tName typeParameters = hsep $ map pretty $ tName : typeParameters
+ src/Data/Morpheus/CodeGen/Internal/Name.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.CodeGen.Internal.Name+  ( toHaskellTypeName,+    camelCaseTypeName,+    toHaskellName,+    camelCaseFieldName,+  )+where++import Data.Char+  ( toLower,+    toUpper,+  )+import Data.Morpheus.Types.Internal.AST+  ( FieldName,+    TypeName,+    packName,+    unpackName,+  )+import qualified Data.Morpheus.Types.Internal.AST as N+import qualified Data.Text as T+import Relude hiding+  ( ToString (..),+    Type,+  )++mapFstChar :: (Char -> Char) -> Text -> Text+mapFstChar f x+  | T.null x = x+  | otherwise = T.singleton (f $ T.head x) <> T.tail x++capitalize :: Text -> Text+capitalize = mapFstChar toUpper++camelCaseTypeName :: [N.Name t] -> TypeName -> TypeName+camelCaseTypeName list name =+  packName $+    T.concat $+      map (capitalize . unpackName) (list <> [coerce name])++toHaskellTypeName :: TypeName -> Text+toHaskellTypeName "String" = "Text"+toHaskellTypeName "Boolean" = "Bool"+toHaskellTypeName "Float" = "Double"+toHaskellTypeName name = capitalize $ unpackName name+{-# INLINE toHaskellTypeName #-}++uncapitalize :: Text -> Text+uncapitalize = mapFstChar toLower++camelCaseFieldName :: TypeName -> FieldName -> FieldName+camelCaseFieldName nSpace name =+  packName $+    uncapitalize (unpackName nSpace)+      <> capitalize (unpackName name)++toHaskellName :: FieldName -> String+toHaskellName name+  | isReserved name = T.unpack (unpackName name <> "'")+  | otherwise = T.unpack (uncapitalize (unpackName name))+{-# INLINE toHaskellName #-}++-- handle reserved Names+isReserved :: FieldName -> Bool+isReserved "case" = True+isReserved "class" = True+isReserved "data" = True+isReserved "default" = True+isReserved "deriving" = True+isReserved "do" = True+isReserved "else" = True+isReserved "foreign" = True+isReserved "if" = True+isReserved "import" = True+isReserved "in" = True+isReserved "infix" = True+isReserved "infixl" = True+isReserved "infixr" = True+isReserved "instance" = True+isReserved "let" = True+isReserved "module" = True+isReserved "newtype" = True+isReserved "of" = True+isReserved "then" = True+isReserved "type" = True+isReserved "where" = True+isReserved "_" = True+isReserved _ = False+{-# INLINE isReserved #-}
+ src/Data/Morpheus/CodeGen/Printer.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.CodeGen.Printer+  ( HSDoc (..),+    Printer (..),+    apply,+    infix',+    print',+    unpack,+    wrapped,+    (.<>),+    optional,+    renderExtension,+    renderImport,+    ignore,+    pack,+  )+where++import Data.Morpheus.Types.Internal.AST+  ( Name,+    TypeRef (..),+    TypeWrapper (..),+    unpackName,+  )+import qualified Data.Text as T+import Prettyprinter (Doc, Pretty (..), list, pretty, tupled, (<+>))+import Relude hiding (optional, print, show)++infix' :: HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n+infix' a op b = pack $ rawDocument a <+> rawDocument op <+> rawDocument b++(.<>) :: HSDoc n -> HSDoc n -> HSDoc n+(.<>) a b = HSDoc True $ unpack a <+> unpack b++apply :: Name t -> [HSDoc n] -> HSDoc n+apply name xs = HSDoc True (foldl' (\b a -> b <+> unpack a) (print' name) xs)++renderMaybe :: Bool -> HSDoc n -> HSDoc n+renderMaybe True = id+renderMaybe False = (.<>) "Maybe"++renderList :: HSDoc n -> HSDoc n+renderList = pack . list . pure . rawDocument++print' :: Printer a => a -> Doc n+print' = unpack . print++pack :: Doc n -> HSDoc n+pack = HSDoc False++unpack :: HSDoc n -> Doc n+unpack HSDoc {..} = if isComplex then tupled [rawDocument] else rawDocument++ignore :: HSDoc n -> Doc n+ignore HSDoc {..} = rawDocument++data HSDoc n = HSDoc+  { isComplex :: Bool,+    rawDocument :: Doc n+  }++class Printer a where+  print :: a -> HSDoc ann++instance IsString (HSDoc n) where+  fromString = pack . pretty++instance Printer TypeRef where+  print TypeRef {..} = wrapped typeWrappers (print typeConName)++wrapped :: TypeWrapper -> HSDoc n -> HSDoc n+wrapped (TypeList wrapper notNull) = renderMaybe notNull . renderList . wrapped wrapper+wrapped (BaseType notNull) = renderMaybe notNull++instance Printer (Name t) where+  print = pack . pretty . T.unpack . unpackName++instance Printer Text where+  print = pack . pretty++instance Printer String where+  print = pack . pretty++optional :: ([a] -> Doc n) -> [a] -> Doc n+optional _ [] = ""+optional f xs = " " <> f xs++renderExtension :: Text -> Doc ann+renderExtension name = "{-#" <+> "LANGUAGE" <+> pretty name <+> "#-}"++renderImport :: (Text, [Text]) -> Doc ann+renderImport (src, ls) = "import" <+> pretty src <> renderImportList ls++renderImportList :: [Text] -> Doc ann+renderImportList ["*"] = ""+renderImportList xs = tupled (map pretty xs)
+ src/Data/Morpheus/CodeGen/TH.hs view
@@ -0,0 +1,343 @@+{-# 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.CodeGen.TH+  ( _',+    apply,+    applyVars,+    toCon,+    ToVar (..),+    ToName (..),+    ToString (..),+    v',+    PrintExp (..),+    PrintType (..),+    PrintDec (..),+    m',+    m_,+    printTypeClass,+    printTypeSynonym,+    destructConstructor,+  )+where++import Data.Morpheus.CodeGen.Internal.AST+  ( CodeGenConstructor (..),+    CodeGenField (..),+    CodeGenType (..),+    CodeGenTypeName (..),+    DerivingClass (..),+    FIELD_TYPE_WRAPPER (..),+    TypeValue (..),+    getFullName,+  )+import Data.Morpheus.CodeGen.Internal.Name (camelCaseFieldName)+import Data.Morpheus.CodeGen.Utils+  ( toHaskellName,+    toHaskellTypeName,+  )+import Data.Morpheus.Types.Internal.AST+  ( FieldName,+    TypeName,+    TypeRef (..),+    TypeWrapper (..),+    unpackName,+  )+import qualified Data.Morpheus.Types.Internal.AST as AST+import qualified Data.Text as T+import Language.Haskell.TH+import Relude hiding+  ( ToString (..),+    Type,+  )++_' :: PatQ+_' = toVar (mkName "_")++v' :: ToVar Name a => a+v' = toVar (mkName "v")++wrappedType :: TypeWrapper -> Type -> Type+wrappedType (TypeList xs nonNull) = withNonNull nonNull . withList . wrappedType xs+wrappedType (BaseType nonNull) = withNonNull nonNull+{-# INLINE wrappedType #-}++declareTypeRef :: (TypeName -> Type) -> TypeRef -> Type+declareTypeRef f TypeRef {typeConName, typeWrappers} =+  wrappedType typeWrappers (f typeConName)+{-# INLINE declareTypeRef #-}++withList :: Type -> Type+withList = AppT (ConT ''[])++withNonNull :: Bool -> Type -> Type+withNonNull True = id+withNonNull False = AppT (ConT ''Maybe)+{-# INLINE withNonNull #-}++class ToName a where+  toName :: a -> Name++instance ToName String where+  toName = mkName++instance ToName Name where+  toName = id++instance ToName Text where+  toName = toName . T.unpack++instance ToName TypeName where+  toName = toName . toHaskellTypeName++instance ToName FieldName where+  toName = mkName . toHaskellName++class ToString a b where+  toString :: a -> b++instance ToString a b => ToString a (Q b) where+  toString = pure . toString++instance ToString TypeName Lit where+  toString = stringL . T.unpack . unpackName++instance ToString TypeName Pat where+  toString = LitP . toString++instance ToString FieldName Lit where+  toString = stringL . T.unpack . unpackName++instance ToString TypeName Exp where+  toString = LitE . toString++instance ToString FieldName Exp where+  toString = LitE . toString++class ToCon a b where+  toCon :: a -> b++instance ToCon a b => ToCon a (Q b) where+  toCon = pure . toCon++instance (ToName a) => ToCon a Type where+  toCon = ConT . toName++instance (ToName a) => ToCon a Exp where+  toCon = ConE . toName++instance (ToName a) => ToCon a Pat where+  toCon name = ConP (toName name) []++class ToVar a b where+  toVar :: a -> b++instance ToVar a b => ToVar a (Q b) where+  toVar = pure . toVar++instance (ToName a) => ToVar a Type where+  toVar = VarT . toName++instance (ToName a) => ToVar a Exp where+  toVar = VarE . toName++instance (ToName a) => ToVar a Pat where+  toVar = VarP . toName++class Apply a where+  apply :: ToCon i a => i -> [a] -> a++instance Apply TypeQ where+  apply = foldl' appT . toCon++instance Apply Type where+  apply = foldl' AppT . toCon++instance Apply Exp where+  apply = foldl' AppE . toCon++instance Apply ExpQ where+  apply = foldl' appE . toCon++applyVars ::+  ( ToName con,+    ToName var,+    Apply res,+    ToCon con res,+    ToVar var res+  ) =>+  con ->+  [var] ->+  res+applyVars name li = apply name (map toVar li)++#if MIN_VERSION_template_haskell(2,15,0)+-- fix breaking changes+typeInstanceDec :: Name -> Type -> Type -> Dec+typeInstanceDec typeFamily arg res = TySynInstD (TySynEqn Nothing (AppT (ConT typeFamily) arg) res)+#else+--+typeInstanceDec :: Name -> Type -> Type -> Dec+typeInstanceDec typeFamily arg res = TySynInstD typeFamily (TySynEqn [arg] res)+#endif++{- ORMOLU_DISABLE -}+#if MIN_VERSION_template_haskell(2,17,0)+toTypeVars :: [Name] -> [TyVarBndr ()]+toTypeVars = map (flip PlainTV ())+#else+toTypeVars :: [Name] -> [TyVarBndr]+toTypeVars = map PlainTV+#endif+{- ORMOLU_ENABLE -}+class PrintExp a where+  printExp :: a -> ExpQ++class PrintType a where+  printType :: a -> TypeQ++class PrintDec a where+  printDec :: a -> Dec++printFieldExp :: (FieldName, TypeValue) -> Q FieldExp+printFieldExp (fName, fValue) = do+  v <- printExp fValue+  pure (toName fName, v)++instance PrintExp TypeValue where+  printExp (TypeValueObject name xs) = recConE (toName name) (map printFieldExp xs)+  printExp (TypeValueNumber x) = [|x|]+  printExp (TypeValueString x) = litE (stringL (T.unpack x))+  printExp (TypeValueBool _) = [|x|]+  printExp (TypedValueMaybe (Just x)) = appE (conE 'Just) (printExp x)+  printExp (TypedValueMaybe Nothing) = conE 'Nothing+  printExp (TypeValueList xs) = listE $ map printExp xs++genName :: DerivingClass -> Name+genName GENERIC = ''Generic+genName SHOW = ''Show+genName CLASS_EQ = ''Eq++printDerivClause :: [DerivingClass] -> DerivClause+printDerivClause derives = DerivClause Nothing (map (ConT . genName) derives)++printField :: CodeGenField -> (Name, Bang, Type)+printField CodeGenField {..} =+  ( toName fieldName,+    Bang NoSourceUnpackedness NoSourceStrictness,+    foldr applyWrapper (toCon fieldType) wrappers+  )++applyWrapper :: FIELD_TYPE_WRAPPER -> Type -> Type+applyWrapper PARAMETRIZED = (`AppT` m')+applyWrapper MONAD = AppT m'+applyWrapper (SUBSCRIPTION name) = AppT (ConT name)+applyWrapper (ARG typeName) = InfixT (ConT (toName typeName)) ''Function+applyWrapper (GQL_WRAPPER wrappers) = wrappedType wrappers+applyWrapper (TAGGED_ARG argName fieldName typeRef) = InfixT arg ''Function+  where+    arg =+      AppT+        ( AppT+            (ConT argName)+            (LitT $ StrTyLit $ T.unpack $ unpackName fieldName)+        )+        (declareTypeRef toCon typeRef)++type Function = (->)++m_ :: Name+m_ = mkName "m"++m' :: Type+m' = VarT m_++constraint :: (Name, Name) -> Q Type+constraint (con, name) = pure $ apply con [toVar name]++printConstraints :: [(Name, Name)] -> Q Cxt+printConstraints = cxt . map constraint++printTypeClass :: [(Name, Name)] -> Name -> Q Type -> [(Name, Type)] -> [(Name, [PatQ], ExpQ)] -> Q Dec+printTypeClass cts name target assoc methods =+  instanceD+    (printConstraints cts)+    headType+    (map assocTypes assoc <> map printFun methods)+  where+    printFun (funName, args, body) = funD funName [clause args (normalB body) []]+    assocTypes (assocName, type') = flip (typeInstanceDec assocName) type' <$> target+    headType = apply name [target]++printConstructor :: CodeGenConstructor -> Con+printConstructor CodeGenConstructor {..}+  | null constructorFields = NormalC (toName constructorName) []+  | otherwise = RecC (toName constructorName) (map printField constructorFields)++printTypeSynonym :: ToName a => a -> [Name] -> Type -> Dec+printTypeSynonym name params = TySynD (toName name) (toTypeVars params)++instance ToName CodeGenTypeName where+  toName = toName . getFullName++instance PrintType CodeGenTypeName where+  printType name = applyVars (toName name) (map toName $ typeParameters name)++instance ToName AST.DirectiveLocation where+  toName AST.QUERY = 'AST.QUERY+  toName AST.MUTATION = 'AST.MUTATION+  toName AST.SUBSCRIPTION = 'AST.SUBSCRIPTION+  toName AST.FIELD = 'AST.FIELD+  toName AST.FRAGMENT_DEFINITION = 'AST.FRAGMENT_DEFINITION+  toName AST.FRAGMENT_SPREAD = 'AST.FRAGMENT_SPREAD+  toName AST.INLINE_FRAGMENT = 'AST.INLINE_FRAGMENT+  toName AST.SCHEMA = 'AST.SCHEMA+  toName AST.SCALAR = 'AST.SCALAR+  toName AST.OBJECT = 'AST.OBJECT+  toName AST.FIELD_DEFINITION = 'AST.FIELD_DEFINITION+  toName AST.ARGUMENT_DEFINITION = 'AST.ARGUMENT_DEFINITION+  toName AST.INTERFACE = 'AST.INTERFACE+  toName AST.UNION = 'AST.UNION+  toName AST.ENUM = 'AST.ENUM+  toName AST.ENUM_VALUE = 'AST.ENUM_VALUE+  toName AST.INPUT_OBJECT = 'AST.INPUT_OBJECT+  toName AST.INPUT_FIELD_DEFINITION = 'AST.INPUT_FIELD_DEFINITION++instance PrintDec CodeGenType where+  printDec CodeGenType {..} =+    DataD+      []+      (toName cgTypeName)+      (toTypeVars $ map toName $ typeParameters cgTypeName)+      Nothing+      (map printConstructor cgConstructors)+      [printDerivClause cgDerivations]++-- |+-- input:+-- >>>+-- WAS WAS destructRecord "User" ["name","id"]+-- >>>+--+-- expression:+-- >>>+-- WAS WAS (User name id)+-- >>>+destructConstructor :: CodeGenConstructor -> PatQ+destructConstructor (CodeGenConstructor conName fields) = conP (toName conName) names+  where+    names = map (typeField conName . fieldName) fields++typeField :: ToVar FieldName c => CodeGenTypeName -> FieldName -> c+typeField conName = toVar . camelCaseFieldName (getFullName conName)
+ src/Data/Morpheus/CodeGen/Utils.hs view
@@ -0,0 +1,14 @@+module Data.Morpheus.CodeGen.Utils+  ( toHaskellTypeName,+    camelCaseTypeName,+    toHaskellName,+    camelCaseFieldName,+  )+where++import Data.Morpheus.CodeGen.Internal.Name+  ( camelCaseFieldName,+    camelCaseTypeName,+    toHaskellName,+    toHaskellTypeName,+  )