Render external type families as grey diamonds in the classes view

External-ref stubs in the classes view all defaulted to kind:
"class", so external families like SigDSIGN / HeaderHash / SignKeyKES
showed as grey rounded-rectangles instead of the grey diamonds the
external-family styling expects. We DO know which refs are families
when they came from a FamilyApp use site (collectFamilyAppsInArgs)
or an associated-type list (ciAssocTypes); collect those qids and
tag their external nodes with kind: "family". Bare superclass refs
still default to "class" — same case as before for Show / Typeable /
NoThunks shaped externals.

Co-Authored-By: Claude Opus 4.7 (1M context) <[email protected]>

diff --git a/src/Classgraph/Render.hs b/src/Classgraph/Render.hs
index ff149bd0ade1200f925f4812c8636820a3455bf3..21d1242c486c452f57c18684bb07973d18e8a10f 100644 (file)
--- a/src/Classgraph/Render.hs
+++ b/src/Classgraph/Render.hs
@@ -198,15 +198,33 @@ buildGraph pd sourceRoots = CyGraph
          , q <- ciAssocTypes c
          , not (Set.member (renderQualName q) knownIds)
          ]
+    -- Refs that we know are families (from a FamilyApp use site or
+    -- an associated-type list) — their external stub gets `kind:
+    -- "family"` so the cytoscape stylesheet renders them as grey
+    -- diamonds, not grey rounded-rectangles.
+    externalFamilyIds = Set.fromList $ map renderQualName $
+         [ q
+         | c  <- pdClasses pd
+         , se <- ciSuperclasses c
+         , q  <- collectFamilyAppsInArgs (seArgs se)
+         , not (Set.member (renderQualName q) knownIds)
+         ]
+      <> [ q
+         | c <- pdClasses pd
+         , q <- ciAssocTypes c
+         , not (Set.member (renderQualName q) knownIds)
+         ]
     externalNodes =
       [ CyNode $ Aeson.object
           [ "id"       Aeson..= renderQualName q
           , "label"    Aeson..= qnName q
-          , "kind"     Aeson..= ("class" :: Text)
-            -- We can't always tell whether `q` is a class or a family from
-            -- a bare reference. Default to "class" (the common case for
-            -- superclass references); the JS instance/family views can
-            -- still drill into the entity if it shows up as a class.
+          , "kind"     Aeson..= externalKind q
+            -- Family refs (associated types and FamilyApp use sites)
+            -- are tagged "family" so they get the grey-diamond
+            -- styling. Bare superclass references default to "class"
+            -- — that's the common case for things like @Show@ /
+            -- @Typeable@ that appear in superclass theta but aren't
+            -- in our dumps.
           , "external" Aeson..= True
           , "module"   Aeson..= qnModule q
           , "package"  Aeson..= qnPackage q
@@ -215,6 +233,10 @@ buildGraph pd sourceRoots = CyGraph
       , Set.member (renderQualName q) referencedIds
       ]
 
+    externalKind q
+      | Set.member (renderQualName q) externalFamilyIds = "family" :: Text
+      | otherwise                                       = "class"
+
     -- Helper: like collectFamilyApps but applied to a list of TypeArgs.
     collectFamilyAppsInArgs as = nub (concatMap collectFamilyApps as)