如何基于GHC.Generics递归统计类型定义中的f出现次数？

我正在通过《Thinking in Types》学习GHC.Generics的结构多态，作为练习编写了countFs函数，用于统计类型定义中指定的f :: Type -> Type的出现次数。当前实现仅能统计顶层的f，无法递归统计子字段（如自定义Other类型）中的f，想了解如何通过类型类实例实现递归统计。

原代码示例 #

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

import Data.Kind
import GHC.Generics

data Example f = Example { a :: f Int, b :: f String, c :: Bool } deriving (Generic)

countFs :: forall (f :: Type -> Type) (a :: Type). (Generic a, GCount f (Rep a)) => Int
countFs = gcount @f @(Rep a)

class GCount (f :: Type -> Type) (a :: Type -> Type) where
  gcount :: Int

instance GCount f U1 where
  gcount = 0

instance GCount f V1 where
  gcount = 0

instance {-# OVERLAPPING #-} GCount f (K1 i (f x)) where
  gcount = 1 -- + recursive call?

instance GCount f (K1 i c) where
  gcount = 0 -- + recursive call?

instance (GCount f a) => GCount f (M1 i c a) where
  gcount = gcount @f @a

instance (GCount f a, GCount f b) => GCount f (a :+: b) where
  gcount = gcount @f @a + gcount @f @b

instance (GCount f a, GCount f b) => GCount f (a :*: b) where
  gcount = gcount @f @a + gcount @f @b

当前问题 #

当添加包含f的子字段后：

newtype Other = Other (Maybe Int) deriving (Generic)
data Example f = Example
  { a :: f Int
  , b :: f String
  , c :: Bool
  , d :: Other
  } deriving (Generic)

调用countFs @Maybe @(Example Maybe)仍返回2，无法统计Other子字段中的f。

解决方案 #

要实现递归统计，需要新增一个辅助类型类处理普通类型的嵌套统计，修改GCount的K1实例以触发递归检查：

修改后的完整代码 #

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

import Data.Kind
import GHC.Generics

data Example f = Example { a :: f Int, b :: f String, c :: Bool } deriving (Generic)

newtype Other = Other (Maybe Int) deriving (Generic)
data ExampleNested f = ExampleNested
  { a :: f Int
  , b :: f String
  , c :: Bool
  , d :: Other
  } deriving (Generic)

-- 顶层统计函数
countFs :: forall (f :: Type -> Type) (a :: Type). (Generic a, GCount f (Rep a)) => Int
countFs = gcount @f @(Rep a)

-- 处理Generic表示类型的统计类
class GCount (f :: Type -> Type) (a :: Type -> Type) where
  gcount :: Int

-- 辅助类：处理任意类型c中f的出现次数
class CountNested (f :: Type -> Type) (c :: Type) where
  countNested :: Int

-- 基础类型或非Generic类型：返回0
instance {-# OVERLAPPABLE #-} CountNested f c where
  countNested = 0

-- Generic类型：递归调用countFs统计
instance (Generic c, GCount f (Rep c)) => CountNested f c where
  countNested = countFs @f @c

-- GCount实例实现
instance GCount f U1 where
  gcount = 0

instance GCount f V1 where
  gcount = 0

-- 匹配f x类型：计数1，同时递归统计x内部的f
instance (CountNested f x) => GCount f (K1 i (f x)) where
  gcount = 1 + countNested @f @x

-- 匹配普通类型：递归统计该类型内部的f
instance (CountNested f c) => GCount f (K1 i c) where
  gcount = countNested @f @c

instance (GCount f a) => GCount f (M1 i c a) where
  gcount = gcount @f @a

instance (GCount f a, GCount f b) => GCount f (a :+: b) where
  gcount = gcount @f @a + gcount @f @b

instance (GCount f a, GCount f b) => GCount f (a :*: b) where
  gcount = gcount @f @a + gcount @f @b

关键说明 #

1. 新增CountNested类：用于处理任意类型中f的嵌套统计。对于实现了Generic的类型，递归调用countFs；对于基础类型（如Int、Bool）或未实现Generic的类型，返回0。
2. 修改K1实例：
   • 对于K1 i (f x)，除了计数1（当前顶层的f），还会通过countNested统计x内部可能存在的f。
   • 对于普通K1 i c，直接调用countNested统计c类型内部的f。

测试验证 #

调用countFs @Maybe @(ExampleNested Maybe)将返回3，正确统计了a、b字段的Maybe，以及d字段Other内部的Maybe。

内容的提问来源于stack exchange，提问作者Alan O'Donnell