我想向您展示您的想法是一个更一般概念的实例 - 压缩。这是您的程序的一个版本，它采用了更简单、更实用的风格。
应用函子
这是Applicative的定义：
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
您可以说f x 类型是一个结构 f，其中包含一些值 x。函数 <*> 采用函数结构 (f (a -> b)) 并将其应用于参数结构 (f a) 以生成结果结构 (f b)。
Zippy 应用程序
使Tree 成为应用函子的一种方法是使<*> 以锁步方式遍历两棵树，压缩它们，就像zip 处理列表一样。每次在函数树中遇到 Node 和在参数树中遇到 Node 时，您都可以将函数拉出并将其应用于参数。当你到达任何一棵树的底部时，你必须停止遍历。
instance Applicative Tree where
pure x = let t = Node x t t in t
Empty <*> _ = Empty
_ <*> Empty = Empty
(Node f lf rf) <*> (Node x lx rx) = Node (f x) (lf <*> lx) (rf <*> rx)
instance Functor Tree where
fmap f x = pure f <*> x -- as usual
pure x 生成xs 的无限树。这很好用，因为 Haskell 是一种惰性语言。
+-----x-----+
| |
+--x--+ +--x--+
| | | |
+-x-+ +-x-+ +-x-+ +-x-+
| | | | | | | |
etc
所以t <*> pure x 的树形与t 的形状相同：只有遇到Empty 时才会停止遍历，而pure x 中没有。 （同样适用于pure x <*> t。）
这是使数据结构成为Applicative 实例的常用方法。例如，标准库中包含ZipList，其Applicative instance与我们的树的Applicative instance非常相似：
newtype ZipList a = ZipList { getZipList :: [a] }
instance Applicative ZipList where
pure x = ZipList (repeat x)
ZipList fs <*> ZipList xs = ZipList (zipWith ($) fs xs)
再一次，pure 生成一个无限的ZipList，而<*> 以锁步方式使用它的参数。
如果您愿意，原型 zippy Applicative 是“阅读器”Applicative (->) r，它通过将函数全部应用于固定参数并收集结果来组合函数。所以所有Representable 函子都承认（至少）一个活泼的Applicative 实例。
使用 some Applicative machinery，我们可以将 Prelude 的 zip 推广到任何应用函子（尽管它只会在 Applicative 本质上是 zippy 时表现得与 zip 完全相同 - 例如，使用常规 @987654366 @instance for [] zipA 将为您提供其参数的笛卡尔积）。
zipA :: Applicative f => f a -> f b -> f (a, b)
zipA = liftA2 (,)
标记为压缩
计划是将输入树与包含每个级别深度的无限树一起压缩。输出将是一棵与输入树形状相同的树（因为深度树是无限的），但每个节点都将标有其深度。
depths :: Tree Integer
depths = go 0
where go n = let t = go (n+1) in Node n t t
这是depths 的样子：
+-----0-----+
| |
+--1--+ +--1--+
| | | |
+-2-+ +-2-+ +-2-+ +-2-+
| | | | | | | |
etc
现在我们已经建立了我们需要的结构，标记一棵树很容易。
labelDepths :: Tree a -> Tree (Integer, a)
labelDepths = zipA depths
按照您最初指定的is easy too，通过丢弃原始标签重新标记树。
relabelDepths :: Tree a -> Tree Integer
relabelDepths t = t *> depths
快速测试：
ghci> let myT = Node 'x' (Node 'y' (Node 'z' Empty Empty) (Node 'a' Empty Empty)) (Node 'b' Empty Empty)
ghci> labelDepths myT
Node (0,'x') (Node (1,'y') (Node (2,'z') Empty Empty) (Node (2,'a') Empty Empty)) (Node (1,'b') Empty Empty)
+--'x'-+ +--(0,'x')-+
| | labelDepths | |
+-'y'-+ 'b' ~~> +-(1,'y')-+ (1,'b')
| | | |
'z' 'a' (2,'z') (2,'a')
您可以通过改变您压缩的树来设计不同的标签方案。这是一个告诉您到达节点的路径：
data Step = L | R
type Path = [Step]
paths :: Tree Path
paths = go []
where go path = Node path (go (path ++ [L])) (go (path ++ [R]))
+--------[ ]--------+
| |
+---[L]---+ +---[R]---+
| | | |
+-[L,L]-+ +-[L,R]-+ +-[R,L]-+ +-[R,R]-+
| | | | | | | |
etc
（可以使用difference lists 缓解上述对++ 的低效调用嵌套。）
labelPath :: Tree a -> Tree (Path, a)
labelPath = zipA paths
随着您继续学习 Haskell，您将更好地发现程序何时是更深层次概念的示例。设置通用结构，就像我在上面的 Applicative 实例中所做的那样，可以很快为代码重用带来好处。