haskell - 如何为包装函数的类型编写任意实例？

Question

我有这种包装函数的类型

newtype Transaction d e r = Transaction (d -> Either e (d,r))

...我想对其 Functor 和 Applicative 实例进行快速检查测试，但编译器提示它没有 Arbitrary 实例。

我尝试这样做，但我一直坚持生成随机函数。

谢谢!

== 更新 ==

快速检查属性是这样定义的

type IdProperty f a = f a -> Bool
functorIdProp :: (Functor f, Eq (f a)) => IdProperty f a
functorIdProp x = (fmap id x) == id x

type CompositionProperty f a b c = f a -> Fun a b -> Fun b c -> Bool
functorCompProp :: (Functor f, Eq (f c)) => CompositionProperty f a b c
functorCompProp x (apply -> f) (apply -> g) = (fmap (g . f) x) == (fmap g . fmap f $ x)

instance (Arbitrary ((->) d  (Either e (d, a)))) => Arbitrary (DbTr d e a) where
    arbitrary = do
      f <- ...???
      return $ Transaction f

...测试看起来像这样:

spec = do
  describe "Functor properties for (Transaction Int String)" $ do
    it "IdProperty (Transaction Int String) Int" $ do
      property (functorIdProp :: IdProperty (Transaction Int String) Int)

    it "CompositionProperty (Transaction Int String) Int String Float" $ do
      property (functorCompProp :: CompositionProperty (Transaction Int String) Int String Float)

Answer 1

你应该使用 Test.QuickCheck.Function包装器来测试功能。如果您只需要为您的 Transaction 测试类型类规则，那么为 Transaction 使用 Arbitrary 或 CoArbitrary 实例似乎没有任何意义 类型(但如果你真的需要它，你可以找到 my answer to this question )。

要测试定律，您可以按如下方式编写属性:

{-# LANGUAGE DeriveFunctor #-}

import Test.QuickCheck
import Test.QuickCheck.Function

newtype Transaction d e r = Transaction (d -> Either e (d,r))
  deriving (Functor)

-- fmap id ≡ id
prop_transactionFunctorId :: Int
                          -> Fun Int (Either Bool (Int,String)) 
                          -> Bool
prop_transactionFunctorId d (Fun _ f) = let t              = Transaction f
                                            Transaction f' = fmap id t
                                        in f' d == f d

好吧，这可能看起来不像您想要的那么漂亮。但这是测试任意函数的好方法。例如，我们可以将最后一行 in f' d == f d 替换为 in f' d == f 1 以查看失败时如何失败:

ghci> quickCheck prop_transactionFunctorId 
*** Failed! Falsifiable (after 2 tests and 4 shrinks):    
0
{0->Left False, _->Right (0,"")}