code-gen: avoid generating duplicate types

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
 

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,15 +125,15 @@ data GQLDirectiveTypeClass = GQLDirectiveTypeClass
   { directiveTypeName :: CodeGenTypeName,
     directiveLocations :: [DirectiveLocation]
   }
-  deriving (Show)
+  deriving (Eq, Show)
 
 data ServerDeclaration
   = GQLTypeInstance Kind (TypeClassInstance ServerMethod)
   | GQLDirectiveInstance (TypeClassInstance ServerMethod)
   | 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)

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 =