Rewrite data-family R: TyCons to abstract family applications

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) <[email protected]>

diff --git a/src/Classgraph/Extract.hs b/src/Classgraph/Extract.hs
index 5de9e1ac1a6ab4f031e4b8eb539c6b6042b0be02..c620aa1d3f698f16eba3853c3043706e103740db 100644 (file)
--- 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)