如何定义可具体化且实例化Functor的Haskell表达式数据类型？

需求背景 #

我们需要定义一种可具体化的表达式数据类型：

• 能转换为字符串（等价于实现Show实例），且后续可解析回原表达式
• 同时成为Functor的实例，支持fmap操作

原有的表达式数据结构定义如下：

data Exp x where
    ConstInt :: Int -> Exp Int
    ConstString :: String -> Exp String
    Product :: Exp a -> Exp b -> Exp (a, b)
    Apply :: String -> (a -> b) -> Exp a -> Exp b

其中：

• 类型变量x表示表达式求值后的结果类型
• ConstInt/ConstString是叶节点表达式
• Product用于组合复合类型表达式
• Apply用于将普通函数"提升"为表达式操作，String字段为函数提供可序列化的标识

原有的求值器和Show实例实现如下：

-- 求值器
eval :: Exp x -> x
eval (ConstInt a) = a
eval (ConstString a) = a
eval (Product a b) = (eval a, eval b)
eval (Apply _ f a) = f (eval a)

-- Show实例（实现可具体化）
instance Show (Exp x) where
    show (ConstInt x) = show x
    show (ConstString x) = "\"" ++ show x ++ "\""
    show (Product a b) = "(" ++ show a ++ ", " ++ show b ++ ")"
    show (Apply name f exp) = name ++ "(" ++ show exp ++ ")"

核心问题 #

直接实现Functor实例时，无法为fmap传入的任意函数生成对应的名称标识：

-- 无法完成的Functor实例
instance Functor Exp where
    fmap f exp = Apply "???" f exp  -- 缺少函数对应的名称字符串

解决方案：通过类型类关联函数与名称 #

我们可以通过定义类型类，为需要被fmap的函数绑定对应的名称，从而解决序列化标识的问题。

步骤1：定义关联函数与名称的类型类 #

class HasFunctionName f where
  getFunctionName :: f -> String

这个类型类用于获取函数对应的序列化名称。

步骤2：为需要使用的函数实现类型类 #

比如为swap函数绑定名称：

swap :: (b, a) -> (a, b)
swap (a, b) = (b, a)

instance HasFunctionName ((b, a) -> (a, b)) where
  getFunctionName _ = "swap"

步骤3：实现带约束的映射逻辑 #

由于标准Functor的fmap没有类型约束，我们有两种实现方式：

方案A：自定义带约束的映射函数

直接定义一个符合需求的映射函数，替代标准fmap：

fmapNamed :: HasFunctionName (a -> b) => (a -> b) -> Exp a -> Exp b
fmapNamed f exp = Apply (getFunctionName f) f exp

使用示例：

example :: Exp (String, Int)
example = fmapNamed swap $ Product (ConstInt 0) (ConstString "string")

方案B：调整Exp类型并实现标准Functor实例

如果一定要实现标准Functor实例，可以修改Apply构造函数，让它接受带名称的函数类型：

-- 定义带名称的函数类型
data NamedFunc a b = NamedFunc String (a -> b)

-- 为NamedFunc实现Show（用于Exp的序列化）
instance Show (NamedFunc a b) where
  show (NamedFunc name _) = name

-- 修改Exp类型
data Exp x where
    ConstInt :: Int -> Exp Int
    ConstString :: String -> Exp String
    Product :: Exp a -> Exp b -> Exp (a, b)
    Apply :: NamedFunc a b -> Exp a -> Exp b

-- 定义将普通函数转为NamedFunc的类型类
class ToNamedFunc a b where
  toNamedFunc :: (a -> b) -> NamedFunc a b

instance HasFunctionName (a -> b) => ToNamedFunc a b where
  toNamedFunc f = NamedFunc (getFunctionName f) f

-- 实现Functor实例
instance Functor Exp where
  fmap f exp = Apply (toNamedFunc f) exp

这种方式下，只有实现了HasFunctionName的函数才能被fmap使用，确保序列化时有合法的名称标识。

补充：解析支持 #

如果要实现从字符串解析回Exp的功能，需要维护一个名称到函数的映射表，示例如下：

import Data.Dynamic

type FuncRegistry = [(String, Dynamic)]

-- 注册函数到注册表
registerFunc :: Typeable f => String -> f -> FuncRegistry -> FuncRegistry
registerFunc name f reg = (name, toDyn f) : reg

-- 从注册表查找函数
lookupFunc :: Typeable f => String -> FuncRegistry -> Maybe f
lookupFunc name reg = do
  dyn <- lookup name reg
  fromDynamic dyn

解析时根据字符串中的函数名称，从注册表中取出对应的函数，再构造Apply节点。

内容的提问来源于stack exchange，提问作者Andy T