如何为Haskell二叉树GADT定义Arrow实例？

你的核心问题在于：标准Arrow类是为元组这类乘积类型设计的，它的核心操作（比如first、***）的类型签名严格绑定了二元组结构，而二叉树是递归的代数数据类型，两者的类型结构完全不匹配，所以硬套Arrow类肯定无法通过编译。

要在树操作中复用箭头风格的组合逻辑，有两种可行思路：

思路一：自定义适配二叉树的箭头类 #

不用硬凑标准Arrow，直接针对二叉树的结构定义专属的箭头类型类，把你需要的mapLeft（对应原first的意图）、mapRight、自定义***、loopTree等操作封装进去。

示例代码 #

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
import Control.Category
import Prelude hiding ((.))

data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq)

-- 封装树操作的箭头类型
newtype TreeArrow a b = TreeArrow { runTreeArrow :: Tree a -> Tree b }

-- 先实现Category，保留函数组合的基础特性
instance Category TreeArrow where
  (TreeArrow f) . (TreeArrow g) = TreeArrow (f . g)
  id = TreeArrow id

-- 自定义针对树的箭头类，包含你需要的操作
class Category arr => TreeRecArrow arr where
  -- 将普通节点映射函数提升为树箭头
  arrNode :: (a -> b) -> arr (Tree a) (Tree b)
  -- 将箭头应用到左子树
  mapLeft :: arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
  -- 将箭头应用到右子树
  mapRight :: arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
  -- 分别用左右箭头操作左右子树（对应自定义***）
  mapBoth :: arr (Tree a) (Tree a) -> arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
  -- 针对树的循环操作，支持节点与子树的状态反馈
  loopTree :: arr (Tree (a, d)) (Tree (b, d)) -> arr (Tree a) (Tree b)

-- 实现TreeArrow的实例
instance TreeRecArrow TreeArrow where
  arrNode f = TreeArrow $ \tree -> case tree of
    Empty -> Empty
    Branch x l r -> Branch (f x) (runTreeArrow (arrNode f) l) (runTreeArrow (arrNode f) r)
  
  mapLeft (TreeArrow f) = TreeArrow $ \tree -> case tree of
    Empty -> Empty
    Branch x l r -> Branch x (f l) r
  
  mapRight (TreeArrow f) = TreeArrow $ \tree -> case tree of
    Empty -> Empty
    Branch x l r -> Branch x l (f r)
  
  mapBoth f g = mapLeft f . mapRight g
  
  -- 示例loop实现：让节点携带反馈状态d，递归处理后提取结果
  loopTree (TreeArrow f) = TreeArrow $ \tree -> case tree of
    Empty -> Empty
    Branch x l r -> 
      let Branch (y, d) l' r' = f (Branch (x, undefined) l r)
      in Branch y (runTreeArrow (loopTree (TreeArrow f)) l') (runTreeArrow (loopTree (TreeArrow f)) r')

思路二：结合标准Arrow与树操作函数 #

如果想保留标准Arrow的生态（比如用Kleisli处理状态、复用现有箭头组合子），可以把树的递归操作封装成标准Arrow能处理的组合子，绕开类型不兼容的问题。

示例代码 #

import Control.Arrow
import Control.Category
import Prelude hiding ((.))
import Control.Monad.State

data Tree a = Empty | Branch a (Tree a) (Tree a) deriving (Show, Eq)

-- 封装mapLeft为标准Arrow组合子
mapLeft :: Arrow arr => arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
mapLeft arr = arr $ \tree -> case tree of
  Empty -> Empty
  Branch x l r -> Branch x (eval arr l) r
  where eval (ArrowTree f) = f  -- 针对你的ArrowTree类型
        eval f = f              -- 针对普通(->)箭头

-- 封装mapRight为标准Arrow组合子
mapRight :: Arrow arr => arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
mapRight arr = arr $ \tree -> case tree of
  Empty -> Empty
  Branch x l r -> Branch x l (eval arr r)
  where eval (ArrowTree f) = f
        eval f = f

-- 自定义***：分别操作左右子树
(***) :: Arrow arr => arr (Tree a) (Tree a) -> arr (Tree a) (Tree a) -> arr (Tree a) (Tree a)
f *** g = mapLeft f . mapRight g

-- 用Kleisli箭头实现带状态的loop操作（比如计算节点深度）
maxDepthArrow :: Kleisli (State Int) (Tree ()) (Tree Int, Int)
maxDepthArrow = Kleisli $ \tree -> case tree of
  Empty -> return (Empty, 0)
  Branch () l r -> do
    (l', d1) <- runKleisli maxDepthArrow l
    (r', d2) <- runKleisli maxDepthArrow r
    let currentDepth = max d1 d2 + 1
    return (Branch currentDepth l' r', currentDepth)

-- 用loop提取最终结果（忽略反馈状态）
computeMaxDepth :: Tree () -> Tree Int
computeMaxDepth tree = evalState (runKleisli (loop maxDepthArrow) tree) 0

关键总结 #

• 标准Arrow和二叉树的类型结构不兼容，不要强行实例化Arrow类。
• 自定义树专属箭头类：完全贴合树的递归操作，自由度高。
• 结合标准Arrow：复用现有箭头生态，适合需要状态管理、复杂组合的场景。

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