{-# LANGUAGE DataKinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Client.Declare.Type ( typeDeclarations, ) where import Data.Morpheus.Client.Internal.Types ( ClientConstructorDefinition (..), ClientTypeDefinition (..), TypeNameTH (..), ) import Data.Morpheus.Client.Internal.Utils ( isEnum, ) import Data.Morpheus.CodeGen.Internal.TH ( camelCaseTypeName, declareTypeRef, toCon, toName, ) import Data.Morpheus.Types.Internal.AST ( ANY, FieldDefinition (..), FieldName, TypeKind (..), TypeName, VALID, ) import Language.Haskell.TH import Relude hiding (Type) typeDeclarations :: TypeKind -> [ClientTypeDefinition -> Q Dec] typeDeclarations :: TypeKind -> [ClientTypeDefinition -> Q Dec] typeDeclarations TypeKind KindScalar = [] typeDeclarations TypeKind _ = [Dec -> Q Dec forall (f :: * -> *) a. Applicative f => a -> f a pure (Dec -> Q Dec) -> (ClientTypeDefinition -> Dec) -> ClientTypeDefinition -> Q Dec forall b c a. (b -> c) -> (a -> b) -> a -> c . ClientTypeDefinition -> Dec declareType] declareType :: ClientTypeDefinition -> Dec declareType :: ClientTypeDefinition -> Dec declareType ClientTypeDefinition { clientTypeName :: ClientTypeDefinition -> TypeNameTH clientTypeName = thName :: TypeNameTH thName@TypeNameTH {[FieldName] namespace :: TypeNameTH -> [FieldName] namespace :: [FieldName] namespace, TypeName typename :: TypeNameTH -> TypeName typename :: TypeName typename}, [ClientConstructorDefinition] clientCons :: ClientTypeDefinition -> [ClientConstructorDefinition] clientCons :: [ClientConstructorDefinition] clientCons } = Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> [Con] -> [DerivClause] -> Dec DataD [] ([FieldName] -> TypeName -> Name mkConName [FieldName] namespace TypeName typename) [] Maybe Kind forall a. Maybe a Nothing (TypeNameTH -> [ClientConstructorDefinition] -> [Con] declareCons TypeNameTH thName [ClientConstructorDefinition] clientCons) ((Name -> DerivClause) -> [Name] -> [DerivClause] forall a b. (a -> b) -> [a] -> [b] map Name -> DerivClause derive [''Generic, ''Show, ''Eq]) where derive :: Name -> DerivClause derive Name className = Maybe DerivStrategy -> Cxt -> DerivClause DerivClause Maybe DerivStrategy forall a. Maybe a Nothing [Name -> Kind ConT Name className] declareCons :: TypeNameTH -> [ClientConstructorDefinition] -> [Con] declareCons :: TypeNameTH -> [ClientConstructorDefinition] -> [Con] declareCons TypeNameTH {[FieldName] namespace :: [FieldName] namespace :: TypeNameTH -> [FieldName] namespace, TypeName typename :: TypeName typename :: TypeNameTH -> TypeName typename} [ClientConstructorDefinition] clientCons | [ClientConstructorDefinition] -> Bool isEnum [ClientConstructorDefinition] clientCons = (ClientConstructorDefinition -> Con) -> [ClientConstructorDefinition] -> [Con] forall a b. (a -> b) -> [a] -> [b] map ClientConstructorDefinition -> Con consE [ClientConstructorDefinition] clientCons | Bool otherwise = (ClientConstructorDefinition -> Con) -> [ClientConstructorDefinition] -> [Con] forall a b. (a -> b) -> [a] -> [b] map ClientConstructorDefinition -> Con consR [ClientConstructorDefinition] clientCons where consE :: ClientConstructorDefinition -> Con consE ClientConstructorDefinition {TypeName cName :: ClientConstructorDefinition -> TypeName cName :: TypeName cName} = Name -> [BangType] -> Con NormalC ([FieldName] -> TypeName -> TypeName -> Name mkTypeName [FieldName] namespace TypeName typename TypeName cName) [] consR :: ClientConstructorDefinition -> Con consR ClientConstructorDefinition {TypeName cName :: TypeName cName :: ClientConstructorDefinition -> TypeName cName, [FieldDefinition ANY VALID] cFields :: ClientConstructorDefinition -> [FieldDefinition ANY VALID] cFields :: [FieldDefinition ANY VALID] cFields} = Name -> [VarBangType] -> Con RecC ([FieldName] -> TypeName -> Name mkConName [FieldName] namespace TypeName cName) ((FieldDefinition ANY VALID -> VarBangType) -> [FieldDefinition ANY VALID] -> [VarBangType] forall a b. (a -> b) -> [a] -> [b] map FieldDefinition ANY VALID -> VarBangType declareField [FieldDefinition ANY VALID] cFields) declareField :: FieldDefinition ANY VALID -> (Name, Bang, Type) declareField :: FieldDefinition ANY VALID -> VarBangType declareField FieldDefinition {FieldName fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldName :: FieldName fieldName, TypeRef fieldType :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> TypeRef fieldType :: TypeRef fieldType} = ( FieldName -> Name forall a. ToName a => a -> Name toName FieldName fieldName, SourceUnpackedness -> SourceStrictness -> Bang Bang SourceUnpackedness NoSourceUnpackedness SourceStrictness NoSourceStrictness, (TypeName -> Kind) -> TypeRef -> Kind declareTypeRef TypeName -> Kind forall a b. ToCon a b => a -> b toCon TypeRef fieldType ) mkTypeName :: [FieldName] -> TypeName -> TypeName -> Name mkTypeName :: [FieldName] -> TypeName -> TypeName -> Name mkTypeName [FieldName] namespace TypeName typename = [FieldName] -> TypeName -> Name mkConName [FieldName] namespace (TypeName -> Name) -> (TypeName -> TypeName) -> TypeName -> Name forall b c a. (b -> c) -> (a -> b) -> a -> c . [TypeName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [TypeName typename] mkConName :: [FieldName] -> TypeName -> Name mkConName :: [FieldName] -> TypeName -> Name mkConName [FieldName] namespace = TypeName -> Name forall a. ToName a => a -> Name toName (TypeName -> Name) -> (TypeName -> TypeName) -> TypeName -> Name forall b c a. (b -> c) -> (a -> b) -> a -> c . [FieldName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [FieldName] namespace