From fc2a7bee5ee94c2f33bfb8ced0f0cffb1f6fd281 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 7 May 2026 02:04:51 +0200 Subject: [PATCH] Render external type families as grey diamonds in the classes view MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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) --- src/Classgraph/Render.hs | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/src/Classgraph/Render.hs b/src/Classgraph/Render.hs index ff149bd..21d1242 100644 --- 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) -- 2.54.0