From 4b7c1a912c1224213e61f4f9f689ac6d007881b0 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 7 May 2026 01:19:42 +0200 Subject: [PATCH] Rewrite data-family R: TyCons to abstract family applications MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit GHC represents `data instance Foo Args = …` internally as a synthetic TyCon `R:FooArgs`. When such a TyCon shows up inside a constraint or instance head — `NoThunks (R:ConsensusConfigPraos c)` — the user reads it as the abstract family application `NoThunks (ConsensusConfig (Praos c))`. Until now we faithfully reported the rep TyCon, which surfaced the synthetic name. In typeArg, gate on tyConFamInst_maybe before the regular TyConApp path: when the TyCon is a data-family instance representation, emit `FamilyApp parent parentArgs` instead. The viewer's existing chain logic then naturally connects the @data instance@ row to any class instance that mentions the abstract family. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/Classgraph/Extract.hs | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/src/Classgraph/Extract.hs b/src/Classgraph/Extract.hs index 5de9e1a..c620aa1 100644 --- a/src/Classgraph/Extract.hs +++ b/src/Classgraph/Extract.hs @@ -58,6 +58,7 @@ import GHC.Core.TyCon , isFamilyTyCon , isInvisibleTyConBinder , tyConBinders + , tyConFamInst_maybe , tyConName , tyConResKind , tyConTuple_maybe @@ -421,12 +422,31 @@ typeArg boundTvs t = Just (a, b) -> TyConApp arrowQualName [typeArg boundTvs a, typeArg boundTvs b] Nothing -> case splitTyConApp_maybe t of - Just (tc, args) -> - let visArgs = visibleArgs tc args - kids = map (typeArg boundTvs) visArgs - in if isFamilyTyCon tc - then FamilyApp (qualName (tyConName tc)) kids - else TyConApp (qualName (tyConName tc)) kids + Just (tc, args) + -- Synthetic data-family-instance representation TyCon. + -- GHC creates one of these (`R:FooArgs`) for each + -- `data instance Foo Args = …` and uses it in the actual + -- type representation. The user wrote @Foo Args@ at source + -- level; that's what we want to surface. Crucially, + -- @parentArgs@ are the abstract family arguments (e.g. + -- @[Praos c]@ for @data instance ConsensusConfig (Praos + -- c)@), not the rep TyCon's own type variables, so we get + -- the right shape back without further work. + -- + -- We classify the result as a 'FamilyApp' so the viewer's + -- chain logic ("there should be a fam-instance somewhere + -- that satisfies this") naturally engages — including + -- finding the matching @data instance@ row and connecting + -- it to any class instance of e.g. @NoThunks (Foo Args)@. + | Just (parent, parentArgs) <- tyConFamInst_maybe tc -> + FamilyApp (qualName (tyConName parent)) + (map (typeArg boundTvs) parentArgs) + | otherwise -> + let visArgs = visibleArgs tc args + kids = map (typeArg boundTvs) visArgs + in if isFamilyTyCon tc + then FamilyApp (qualName (tyConName tc)) kids + else TyConApp (qualName (tyConName tc)) kids Nothing -> case isLitTy t of Just _ -> LitArg (pprText t) Nothing -> OtherArg (pprText t) -- 2.54.0