diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs index 6c0444c23..934aab095 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs @@ -62,7 +62,7 @@ data DerivingClass = SHOW | GENERIC | CLASS_EQ - deriving (Show) + deriving (Eq, Show) instance Pretty DerivingClass where pretty SHOW = "Show" @@ -77,7 +77,7 @@ data TypeValue | TypeValueList [TypeValue] | TypedValueMaybe (Maybe TypeValue) | PrintableTypeValue PrintableValue - deriving (Show) + deriving (Eq, Show) renderField :: (FieldName, TypeValue) -> Doc n renderField (fName, fValue) = pretty (unpackName fName :: Text) <+> "=" <+> pretty fValue @@ -101,7 +101,7 @@ data CodeGenType = CodeGenType cgConstructors :: [CodeGenConstructor], cgDerivations :: [DerivingClass] } - deriving (Show) + deriving (Eq, Show) isNewType :: CodeGenType -> Bool isNewType CodeGenType {cgConstructors = [CodeGenConstructor {constructorFields = [_]}]} = True @@ -128,7 +128,7 @@ data CodeGenConstructor = CodeGenConstructor { constructorName :: CodeGenTypeName, constructorFields :: [CodeGenField] } - deriving (Show) + deriving (Eq, Show) instance Printer CodeGenConstructor where print CodeGenConstructor {constructorFields = [CodeGenField {fieldName = "_", ..}], ..} = @@ -147,7 +147,7 @@ data CodeGenField = CodeGenField wrappers :: [FIELD_TYPE_WRAPPER], fieldIsNullable :: Bool } - deriving (Show) + deriving (Eq, Show) instance Printer CodeGenField where print CodeGenField {..} = infix' (print fieldName) "::" (foldr renderWrapper (print fieldType) wrappers) @@ -159,7 +159,7 @@ data FIELD_TYPE_WRAPPER | ARG TypeName | TAGGED_ARG TH.Name FieldName TypeRef | GQL_WRAPPER TypeWrapper - deriving (Show) + deriving (Eq, Show) renderWrapper :: FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n renderWrapper PARAMETRIZED = (.<> "m") @@ -174,7 +174,7 @@ data CodeGenTypeName = CodeGenTypeName typeParameters :: [Text], typename :: TypeName } - deriving (Show) + deriving (Eq, Show) getFullName :: CodeGenTypeName -> TypeName getFullName CodeGenTypeName {..} = camelCaseTypeName namespace typename @@ -248,7 +248,7 @@ data TypeClassInstance body = TypeClassInstance assoc :: [(TH.Name, AssociatedType)], typeClassMethods :: [(TH.Name, MethodArgument, body)] } - deriving (Show) + deriving (Eq, Show) instance (Pretty a) => Pretty (TypeClassInstance a) where pretty TypeClassInstance {..} = @@ -271,7 +271,7 @@ renderTypeableConstraints xs = tupled (map (("Typeable" <+>) . pretty) xs) <+> " data AssociatedType = AssociatedTypeName TH.Name | AssociatedLocations [DirectiveLocation] - deriving (Show) + deriving (Eq, Show) printTHName :: TH.Name -> Doc ann printTHName = ignore . print @@ -287,7 +287,7 @@ data MethodArgument = NoArgument | ProxyArgument | DestructArgument TH.Name [TH.Name] - deriving (Show) + deriving (Eq, Show) instance Pretty MethodArgument where pretty NoArgument = "" @@ -297,6 +297,9 @@ instance Pretty MethodArgument where data PrintableValue where PrintableValue :: forall a. (Show a, Lift a) => a -> PrintableValue +instance Eq PrintableValue where + a == b = show a == show b + instance Show PrintableValue where show (PrintableValue a) = show a diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs index e836a0c5c..350d1ed87 100644 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs @@ -84,7 +84,7 @@ data ServerDirectiveUsage = TypeDirectiveUsage TypeValue | FieldDirectiveUsage FieldName TypeValue | EnumDirectiveUsage TypeName TypeValue - deriving (Show) + deriving (Eq, Show) instance PrintExp ServerDirectiveUsage where printExp (TypeDirectiveUsage x) = appE (varE 'typeDirective) (printExp x) @@ -101,14 +101,14 @@ data GQLTypeDefinition = GQLTypeDefinition gqlKind :: Kind, gqlTypeDirectiveUses :: [ServerDirectiveUsage] } - deriving (Show) + deriving (Eq, Show) data InterfaceDefinition = InterfaceDefinition { aliasName :: TypeName, interfaceName :: TypeName, unionName :: TypeName } - deriving (Show) + deriving (Eq, Show) instance PrintDec InterfaceDefinition where printDec InterfaceDefinition {..} = @@ -125,7 +125,7 @@ data GQLDirectiveTypeClass = GQLDirectiveTypeClass { directiveTypeName :: CodeGenTypeName, directiveLocations :: [DirectiveLocation] } - deriving (Show) + deriving (Eq, Show) data ServerDeclaration = GQLTypeInstance Kind (TypeClassInstance ServerMethod) @@ -133,7 +133,7 @@ data ServerDeclaration | DataType CodeGenType | ScalarType {scalarTypeName :: Text} | InterfaceType InterfaceDefinition - deriving (Show) + deriving (Eq, Show) instance Pretty ServerDeclaration where pretty (InterfaceType InterfaceDefinition {..}) = @@ -157,7 +157,7 @@ newtype CodeGenConfig = CodeGenConfig {namespace :: Bool} data ServerMethod = ServerMethodDefaultValues (Map Text (Value CONST)) | ServerMethodDirectives [ServerDirectiveUsage] - deriving (Show) + deriving (Eq, Show) instance Pretty ServerMethod where pretty (ServerMethodDefaultValues x) = pretty (show x) diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs index eae9639e7..78f6ea276 100755 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs @@ -15,6 +15,7 @@ module Data.Morpheus.CodeGen.Server.Interpreting.Transform where import Data.ByteString.Lazy.Char8 (ByteString) +import Data.List (nub) import Data.Morpheus.CodeGen.Internal.AST ( AssociatedType (..), CodeGenConstructor (..), @@ -100,7 +101,9 @@ parseServerTypeDefinitions :: (CodeGenMonad m) => CodeGenConfig -> ByteString -> parseServerTypeDefinitions ctx txt = case parseDefinitions txt of Failure errors -> fail (renderGQLErrors errors) - Success {result, warnings} -> printWarnings warnings >> toTHDefinitions (namespace ctx) result + Success {result, warnings} -> do + printWarnings warnings + first nub <$> toTHDefinitions (namespace ctx) result getExternals :: [ServerDeclaration] -> Flags getExternals xs =