From: Javier Sagredo <javier.sagredo@iohk.io>
Date: Sun, 3 May 2026 23:36:23 +0000 (+0200)
Subject: Data families: (data) label, hide synthetic RHS, per-family filter; fix instance... 
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=fd66da4600fd5ccafdf27a2af4c57375fe34603b;p=classgraph.git

Data families: (data) label, hide synthetic RHS, per-family filter; fix instance source spans
---

diff --git a/data/viewer.js b/data/viewer.js
index 514f6c2..0eb256f 100644
--- a/data/viewer.js
+++ b/data/viewer.js
@@ -149,13 +149,26 @@
   }
 
   // -------------------------------------------------------------------------
-  // Instance filter (right-hand side panel)
+  // Visibility filter (right-hand side panel) — used in *both* the instance
+  // view (per-class instance checkboxes) and the family view (per-family
+  // type-instance checkboxes). The DOM is shared; each row carries a
+  // data-kind ("inst" or "fam") so the change handler routes the toggle
+  // to the right per-target hidden-set Map.
 
   const filterEl       = document.getElementById('instance-filter');
   const filterListEl   = document.getElementById('filter-list');
   const filterSummary  = document.getElementById('filter-summary');
   const filterSearch   = document.getElementById('filter-search');
 
+  // Per-family set of hidden fam-instance _idx values. Independent from
+  // hiddenInstancesByClass; persists across navigation.
+  const hiddenFamInstancesByFamily = new Map();
+  function getHiddenFamInsts(familyId) {
+    let s = hiddenFamInstancesByFamily.get(familyId);
+    if (!s) { s = new Set(); hiddenFamInstancesByFamily.set(familyId, s); }
+    return s;
+  }
+
   function renderInstanceFilter(classId) {
     const insts = instancesByClass.get(classId) || [];
     if (insts.length === 0) {
@@ -169,7 +182,30 @@
     filterListEl.innerHTML = insts.map(inst => {
       const head = renderInstanceHead(inst);
       const isHidden = hidden.has(inst._idx);
-      return `<li data-idx="${inst._idx}">
+      return `<li data-idx="${inst._idx}" data-kind="inst">
+        <label class="${isHidden ? 'unchecked' : ''}">
+          <input type="checkbox" ${isHidden ? '' : 'checked'} />
+          <span class="head" title="${escapeAttr(head)}">${escape(head)}</span>
+        </label>
+      </li>`;
+    }).join('');
+    applyFilterSearch();
+  }
+
+  function renderFamilyFilter(familyId) {
+    const fis = famInstsByFamily.get(familyId) || [];
+    if (fis.length === 0) {
+      filterEl.hidden = true;
+      return;
+    }
+    filterEl.hidden = false;
+    const hidden = getHiddenFamInsts(familyId);
+    const visible = fis.length - hidden.size;
+    filterSummary.textContent = `Type instances (${visible} / ${fis.length})`;
+    filterListEl.innerHTML = fis.map(fi => {
+      const head = renderFamInstHead(fi);
+      const isHidden = hidden.has(fi._idx);
+      return `<li data-idx="${fi._idx}" data-kind="fam">
         <label class="${isHidden ? 'unchecked' : ''}">
           <input type="checkbox" ${isHidden ? '' : 'checked'} />
           <span class="head" title="${escapeAttr(head)}">${escape(head)}</span>
@@ -189,33 +225,65 @@
   }
 
   filterListEl.addEventListener('change', evt => {
-    if (state.view !== 'instance' || !state.classId) return;
     const cb = evt.target.closest('input[type="checkbox"]');
     if (!cb) return;
     const li = cb.closest('li[data-idx]');
     if (!li) return;
-    const idx = parseInt(li.dataset.idx, 10);
-    const hidden = getHidden(state.classId);
-    if (cb.checked) hidden.delete(idx); else hidden.add(idx);
-    rebuildInstanceView();
+    const idx  = parseInt(li.dataset.idx, 10);
+    const kind = li.dataset.kind || 'inst';
+    if (kind === 'inst' && state.view === 'instance' && state.classId) {
+      const hidden = getHidden(state.classId);
+      if (cb.checked) hidden.delete(idx); else hidden.add(idx);
+      rebuildInstanceView();
+    } else if (kind === 'fam' && state.view === 'family' && state.familyId) {
+      const hidden = getHiddenFamInsts(state.familyId);
+      if (cb.checked) hidden.delete(idx); else hidden.add(idx);
+      rebuildFamilyView();
+    }
   });
 
   document.getElementById('filter-all').addEventListener('click', () => {
-    if (state.view !== 'instance' || !state.classId) return;
-    getHidden(state.classId).clear();
-    rebuildInstanceView();
+    if (state.view === 'instance' && state.classId) {
+      getHidden(state.classId).clear();
+      rebuildInstanceView();
+    } else if (state.view === 'family' && state.familyId) {
+      getHiddenFamInsts(state.familyId).clear();
+      rebuildFamilyView();
+    }
   });
 
   document.getElementById('filter-none').addEventListener('click', () => {
-    if (state.view !== 'instance' || !state.classId) return;
-    const insts = instancesByClass.get(state.classId) || [];
-    const hidden = getHidden(state.classId);
-    insts.forEach(i => hidden.add(i._idx));
-    rebuildInstanceView();
+    if (state.view === 'instance' && state.classId) {
+      const insts = instancesByClass.get(state.classId) || [];
+      const hidden = getHidden(state.classId);
+      insts.forEach(i => hidden.add(i._idx));
+      rebuildInstanceView();
+    } else if (state.view === 'family' && state.familyId) {
+      const fis = famInstsByFamily.get(state.familyId) || [];
+      const hidden = getHiddenFamInsts(state.familyId);
+      fis.forEach(fi => hidden.add(fi._idx));
+      rebuildFamilyView();
+    }
   });
 
   filterSearch.addEventListener('input', applyFilterSearch);
 
+  // Re-run the family view with the current visibility set, preserving pan/zoom.
+  function rebuildFamilyView() {
+    if (state.view !== 'family' || !state.familyId) return;
+    const pan  = cy.pan();
+    const zoom = cy.zoom();
+    loadGraph(buildFamilyView(state.familyId));
+    cy.layout({ name: 'dagre', rankDir: 'TB', nodeSep: 30, rankSep: 80 }).run();
+    cy.pan(pan);
+    cy.zoom(zoom);
+    const fis = famInstsByFamily.get(state.familyId) || [];
+    const hidden = getHiddenFamInsts(state.familyId).size;
+    const visiblePart = hidden > 0 ? `${fis.length - hidden}/${fis.length}` : `${fis.length}`;
+    setCounts(`${visiblePart} type instances`);
+    renderFamilyFilter(state.familyId);
+  }
+
   function switchToFamily(familyId, opts) {
     const els = buildFamilyView(familyId);
     if (!els) return;
@@ -230,8 +298,10 @@
     setHint('family');
     setBackVisible(true);
     const fis = famInstsByFamily.get(familyId) || [];
-    setCounts(`${fis.length} type instances`);
-    document.getElementById('instance-filter').hidden = true;
+    const hidden = getHiddenFamInsts(familyId).size;
+    const visiblePart = hidden > 0 ? `${fis.length - hidden}/${fis.length}` : `${fis.length}`;
+    setCounts(`${visiblePart} type instances`);
+    renderFamilyFilter(familyId);
     showSelection(null);
     if (!opts || !opts.fromHistory) {
       history.pushState({ view: 'family', familyId }, '', '#families/' + encodeURIComponent(familyId));
@@ -492,11 +562,13 @@
       if (seenNodes.has(id)) return id;
       seenNodes.add(id);
       const known = familyById.get(id);
+      const isData = isDataFamily(known);
       els.push({ group: 'nodes', data: {
         id,
-        label: qn.qnName,
+        label: qn.qnName + (isData ? ' (data)' : ''),
         kind: 'family',
         external: !known,
+        isData: !!isData,
         package: qn.qnPackage,
         module: qn.qnModule,
       }});
@@ -765,11 +837,13 @@
     // Focused family node.
     const famNodeId = qid(fam.tfName);
     seenNodes.add(famNodeId);
+    const focusedIsData = isDataFamily(fam);
     els.push({ group: 'nodes', data: {
       id: famNodeId,
-      label: fam.tfName.qnName,
+      label: fam.tfName.qnName + (focusedIsData ? ' (data)' : ''),
       kind: 'family',
       focused: true,
+      isData: !!focusedIsData,
       package: fam.tfName.qnPackage,
       module: fam.tfName.qnModule,
     }});
@@ -788,13 +862,20 @@
       }});
     }
 
-    // Each fam instance = one row beneath the family.
+    // Each fam instance = one row beneath the family. Filter out the ones
+    // hidden by the per-family checkbox panel.
+    const hidden = getHiddenFamInsts(familyId);
     fis.forEach(fi => {
+      if (hidden.has(fi._idx)) return;
       const fiNodeId = 'faminst:' + fi._idx;
       seenNodes.add(fiNodeId);
+      const args = renderArgsCompact(fi.fiArgs, fi.fiTyVars);
+      const label = fi.fiIsData
+        ? (args || '<no args>')
+        : args + ' = ' + renderArg(fi.fiRhs, fi.fiTyVars);
       els.push({ group: 'nodes', data: {
         id: fiNodeId,
-        label: renderArgsCompact(fi.fiArgs, fi.fiTyVars) + ' = ' + renderArg(fi.fiRhs, fi.fiTyVars),
+        label,
         kind: 'fam-instance',
         familyId: famNodeId,
         famInstance: fi,
@@ -1061,11 +1142,15 @@
   }
 
   // Pretty-print "Element [a] = a" — short form used as a node label in the
-  // instance view and as the row label in the family view.
+  // instance view and as the row label in the family view. For data-family
+  // instances the RHS is a synthetic GHC-internal data-constructor TyCon
+  // (e.g. `R:TickedFUN…`), so we drop the `= rhs` suffix entirely; the
+  // existence of the row is the meaningful information.
   function renderFamInstHead(fi) {
     const args = renderArgsCompact(fi.fiArgs, fi.fiTyVars);
-    const rhs  = renderArg(fi.fiRhs, fi.fiTyVars);
-    return fi.fiFamily.qnName + ' ' + args + ' = ' + rhs;
+    const head = fi.fiFamily.qnName + (args ? ' ' + args : '');
+    if (fi.fiIsData) return head;
+    return head + ' = ' + renderArg(fi.fiRhs, fi.fiTyVars);
   }
 
   function renderArgsCompact(args, boundTvs) {
@@ -1121,6 +1206,16 @@
 
   // Returns the infix operator string for a TyCon name that should render
   // infix (currently the various equality and coercion-evidence forms).
+  // Detect whether a TypeFamilyInfo (from familyById) describes a data
+  // family. tfFlavor is either a literal string (e.g. "OpenFam") for the
+  // unary constructors or an object with a `tag` field for sums that
+  // carry data (AssocFam carries a parent class qualname).
+  function isDataFamily(fam) {
+    if (!fam || !fam.tfFlavor) return false;
+    if (fam.tfFlavor === 'DataFam') return true;
+    return fam.tfFlavor.tag === 'DataFam';
+  }
+
   function infixOpName(name) {
     if (name === '->' || name === '(->)') return '->';
     if (name === '~'  || name === '(~)')  return '~';
diff --git a/examples/demo/src/Demo/MoreFamilies.hs b/examples/demo/src/Demo/MoreFamilies.hs
index 5466511..e253755 100644
--- a/examples/demo/src/Demo/MoreFamilies.hs
+++ b/examples/demo/src/Demo/MoreFamilies.hs
@@ -37,3 +37,12 @@ class HasBaggedInfo a where
 
 instance Pretty (Bag a) => HasBaggedInfo a where
   baggedInfo _ = "bagged"
+
+-- A /data family/ — the viewer should render its instance rows without
+-- the synthetic @R:…@ data-constructor RHS. The line should just say
+-- @Crate [Int]@ etc., not @Crate [Int] = R:Crate[]Intmk@.
+data family Crate a
+
+data instance Crate Int  = CrateInt  Int
+data instance Crate Bool = CrateBool Bool
+data instance Crate [a]  = CrateList [a]
diff --git a/src/Classgraph/Extract.hs b/src/Classgraph/Extract.hs
index f2d4ba0..8b4ffa8 100644
--- a/src/Classgraph/Extract.hs
+++ b/src/Classgraph/Extract.hs
@@ -29,9 +29,15 @@ import GHC.Core.Coercion.Axiom
   , cab_rhs
   , cab_tvs
   , co_ax_branches
+  , coAxBranchSpan
+  , coAxiomSingleBranch
   , fromBranches
   )
-import GHC.Core.FamInstEnv (FamInst (..))
+import GHC.Core.FamInstEnv
+  ( FamFlavor (..)
+  , FamInst (..)
+  , famInstTyCon
+  )
 import GHC.Core.Predicate
   ( EqRel (..)
   , Pred (..)
@@ -41,6 +47,7 @@ import GHC.Core (IsOrphan, isOrphan)
 import GHC.Core.InstEnv
   ( ClsInst
   , instanceSig
+  , is_dfun
   , is_flag
   , is_orphan
   )
@@ -221,9 +228,13 @@ extractInstance inst =
         , iiTyVars  = map tyVarInfo tvs
         , iiOrphan  = orphanFlag (is_orphan inst)
         , iiOverlap = Just (pprText (is_flag inst))
-          -- The dfun's name span would be more precise; for synthesised
-          -- dfuns it's often unhelpful, so fall back to the class name.
-        , iiSrc     = srcSpanInfo (nameSrcSpan (className cls))
+          -- The dictionary function's name span IS the instance's source
+          -- location (GHC tags the dfun with the @instance ...@ declaration
+          -- it was synthesised from). The class's name span — what we used
+          -- to read here — points at the *class declaration*, which for
+          -- classes loaded from another package's interface file has an
+          -- UnhelpfulSpan, hence "unknown" in the side panel.
+        , iiSrc     = srcSpanInfo (nameSrcSpan (varName (is_dfun inst)))
         }
 
 orphanFlag :: IsOrphan -> Bool
@@ -305,25 +316,40 @@ extractTypeFamily assocByName tc
     -- instances.
     closedEquations = case famTyConFlav_maybe tc of
       Just (ClosedSynFamilyTyCon (Just ax)) ->
-        map (extractClosedBranch (tyConName tc)) (fromBranches (co_ax_branches ax))
+        map (extractClosedBranch tc) (fromBranches (co_ax_branches ax))
       _ -> []
 
-extractClosedBranch :: Name -> CoAxBranch -> FamInstInfo
-extractClosedBranch famName br = FamInstInfo
-  { fiFamily = qualName famName
+extractClosedBranch :: TyCon -> CoAxBranch -> FamInstInfo
+extractClosedBranch tc br = FamInstInfo
+  { fiFamily = qualName (tyConName tc)
   , fiTyVars = map tyVarInfo (cab_tvs br)
-  , fiArgs   = map (typeArg (cab_tvs br)) (cab_lhs br)
+  , fiArgs   = map (typeArg (cab_tvs br)) (visibleArgs tc (cab_lhs br))
   , fiRhs    = typeArg (cab_tvs br) (cab_rhs br)
   , fiSrc    = srcSpanInfo (cab_loc br)
+  , fiIsData = False
   }
 
 extractFamInst :: FamInst -> FamInstInfo
 extractFamInst fi = FamInstInfo
   { fiFamily = qualName (fi_fam fi)
   , fiTyVars = map tyVarInfo (fi_tvs fi)
-  , fiArgs   = map (typeArg (fi_tvs fi)) (fi_tys fi)
+    -- Strip invisible (kind) args that GHC bakes into fi_tys. Without this
+    -- a poly-kinded family instance like
+    --   data instance Ticked (LedgerState (ShelleyBlock proto era)) = …
+    -- comes through as `Ticked ((TYPE (BoxedRep Lifted)) -> …, LedgerState,
+    -- (ShelleyBlock proto era))` because the kind of the family's type
+    -- parameter is also stuffed into fi_tys.
+  , fiArgs   = map (typeArg (fi_tvs fi))
+                   (visibleArgs (famInstTyCon fi) (fi_tys fi))
   , fiRhs    = typeArg (fi_tvs fi) (fi_rhs fi)
-  , fiSrc    = srcSpanInfo (nameSrcSpan (fi_fam fi))
+    -- Use the CoAxBranch's source span (the actual @type instance F …@ /
+    -- @data instance F …@ declaration), not the family TyCon's name span
+    -- (which points at the original @data family@ / @type family@ decl).
+  , fiSrc    = srcSpanInfo (coAxBranchSpan
+                              (coAxiomSingleBranch (fi_axiom fi)))
+  , fiIsData = case fi_flavor fi of
+      SynFamilyInst    -> False
+      DataFamilyInst _ -> True
   }
 
 ------------------------------------------------------------------------------
diff --git a/src/Classgraph/Render.hs b/src/Classgraph/Render.hs
index 9e2af6f..4d5901c 100644
--- a/src/Classgraph/Render.hs
+++ b/src/Classgraph/Render.hs
@@ -105,15 +105,23 @@ buildGraph pd = CyGraph
     familyNodes =
       [ CyNode $ Aeson.object
           [ "id"      Aeson..= renderQualName (tfName f)
-          , "label"   Aeson..= (qnName (tfName f) <> " (family)")
+          , "label"   Aeson..= familyNodeLabel f
           , "kind"    Aeson..= ("family" :: Text)
           , "module"  Aeson..= qnModule (tfName f)
           , "package" Aeson..= qnPackage (tfName f)
           , "flavor"  Aeson..= flavorTag (tfFlavor f)
+          , "isData"  Aeson..= isDataFamily f
           ]
       | f <- pdTypeFamilies pd
       ]
 
+    familyNodeLabel f =
+      qnName (tfName f) <> if isDataFamily f then " (data)" else ""
+
+    isDataFamily f = case tfFlavor f of
+      DataFam -> True
+      _       -> False
+
     -- Stub nodes for any QualName referenced by an edge but not defined
     -- locally (typically classes from external packages — base, ghc-internal,
     -- nothunks, etc.). Cytoscape rejects edges with missing endpoints, so
diff --git a/src/Classgraph/Schema.hs b/src/Classgraph/Schema.hs
index f4339c7..e6fb238 100644
--- a/src/Classgraph/Schema.hs
+++ b/src/Classgraph/Schema.hs
@@ -182,9 +182,32 @@ data FamInstInfo = FamInstInfo
   , fiArgs   :: ![TypeArg]
   , fiRhs    :: !TypeArg
   , fiSrc    :: !(Maybe SrcSpanInfo)
+  , fiIsData :: !Bool
+    -- ^ 'True' when this is a /data/ family instance (the RHS is a
+    -- synthetic @R:…@ data-constructor TyCon, not a meaningful type to
+    -- show); 'False' for a regular @type instance F … = …@. The viewer
+    -- hides the RHS for data-family rows.
   }
   deriving stock (Generic, Show, Eq)
-  deriving anyclass (ToJSON, FromJSON)
+
+instance ToJSON FamInstInfo where
+  toJSON fi = object
+    [ "fiFamily" .= fiFamily fi
+    , "fiTyVars" .= fiTyVars fi
+    , "fiArgs"   .= fiArgs fi
+    , "fiRhs"    .= fiRhs fi
+    , "fiSrc"    .= fiSrc fi
+    , "fiIsData" .= fiIsData fi
+    ]
+
+instance FromJSON FamInstInfo where
+  parseJSON = withObject "FamInstInfo" $ \o -> FamInstInfo
+    <$> o .:  "fiFamily"
+    <*> o .:  "fiTyVars"
+    <*> o .:  "fiArgs"
+    <*> o .:  "fiRhs"
+    <*> o .:  "fiSrc"
+    <*> o .:? "fiIsData" .!= False
 
 data SrcSpanInfo = SrcSpanInfo
   { ssFile      :: !Text