检查BinTree的Applicative同态律时QuickCheck返回0测试的解决办法

我希望验证自定义数据类型BinTree的Applicative同态律是否成立，编写了如下Haskell代码，但执行时QuickCheck返回(0 tests)，无法完成测试：

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-} 
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Laws where

import Control.Applicative ((<$>), liftA3)

import Data.Monoid

import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Gen

data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving (Show, Eq)

instance Functor BinTree where
    fmap _ Empty = Empty
    fmap f (Node x hi hd) = Node (f x) (fmap f hi) (fmap f hd)

instance Applicative BinTree where
    -- pure :: a -> BinTree a
    pure x = Node x (pure x) (pure x)

    -- <*> :: BinTree (a -> b) -> BinTree a -> BinTree b
    _ <*> Empty = Empty -- L1, 
    Empty <*> t = Empty
    (Node f l r) <*> (Node x l' r') = Node (f x) (l <*> l') (r <*> r')

instance (Arbitrary a) => Arbitrary (BinTree a) where
    arbitrary = oneof [return Empty, -- oneof :: [Gen a] -> Gen a
                liftA3 Node arbitrary arbitrary arbitrary]
                
-- Identity
apIdentityProp :: (Applicative f, Eq (f a)) => f a -> Bool
apIdentityProp v = (pure id <*> v) == v

apHomomorphismProp :: forall f a b. (Applicative f, Eq (f b)) => Fun a b -> a -> Bool
apHomomorphismProp (apply -> g) x = (pure @f g <*> pure x) == pure (g x)

main = quickCheck $ apHomomorphismProp @BinTree @Int @Int

执行后得到的错误输出：

(0 tests)

问题根源 #

核心问题在于BinTree的Applicative实例中pure的定义是无限递归的：

pure x = Node x (pure x) (pure x)

这个定义会生成无限嵌套的树结构，QuickCheck无法生成、处理或比较这种无限数据，导致测试无法启动，直接返回0测试结果。

解决方案 #

修改pure的定义，让它生成有限的BinTree，比如创建一个仅包含根节点、左右子树为空的树：

instance Applicative BinTree where
    -- 改为有限结构的pure
    pure x = Node x Empty Empty
    -- 保持<*>的逻辑不变
    _ <*> Empty = Empty
    Empty <*> t = Empty
    (Node f l r) <*> (Node x l' r') = Node (f x) (l <*> l') (r <*> r')

修改后，QuickCheck就能正常生成测试用例，执行同态律的验证了。

补充说明 #

如果必须使用无限结构的pure，则需要自定义针对无限递归类型的相等性判断（比如只比较有限深度的结构），或者使用有限近似的生成器，但这会大幅增加代码复杂度。因此最简洁可靠的方案是让pure生成有限树。

内容的提问来源于stack exchange，提问作者F. Zer