How to write quickCheck on properties of functions?

Question

I'm trying to do one of the Monoid exercises in Haskell Book (Chapter 15, "Monoid, Semigroup") but I'm stuck. The following is given:

newtype Combine a b =
  Combine { unCombine :: (a -> b) }

and I'm supposed to write the Monoid instance for Combine.

I wrote something like this:

instance (Semigroup b) => Semigroup (Combine a b) where
  Combine { unCombine = f } <> Combine { unCombine = g } =
    Combine { unCombine = \x -> f x <> g x }

instance (Monoid b) => Monoid (Combine a b) where
  mempty = Combine { unCombine = \_ -> mempty }
  mappend = (<>)

but I do not know how to write the quickCheck for the instance.

Here is my try (does not compile):

monoidLeftIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity1 x = mappend mempty x == x

monoidRightIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity1 x = mappend x mempty == x


main :: IO ()
main = do 
  quickCheck (monoidLeftIdentity1 :: Combine Int (Sum Int) -> Bool)
  quickCheck (monoidRightIdentity1 :: Combine Int (Sum Int) -> Bool)

It seems I must instance Arbitrary and Eq on this type, but how to write them for a function?

There is a similar question, in that question, we are asked to write the Semigroup instance for Combine.

Answer 1

First a full code example:

module Main where

import Test.QuickCheck
import Data.Monoid

newtype Combine a b = Combine { unCombine :: a -> b }

instance (Semigroup b) => Semigroup (Combine a b) where
    a <> _ = a
--  (Combine f) <> (Combine g) = Combine $ \a -> (f a) <> (g a)

instance (Monoid b) => Monoid (Combine a b) where
  mempty = Combine $ \_ -> mempty

monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity m = mappend mempty m == m

monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity m = mappend m mempty == m

monoidLeftIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidLeftIdentityF wrap eval point candidate = eval (mappend mempty m) point == eval m point 
 where m = wrap candidate

monoidRightIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidRightIdentityF wrap eval point candidate = eval (mappend m mempty) point == eval m point 
 where m = wrap candidate

main :: IO ()
main = do
  quickCheck $ (monoidLeftIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
  quickCheck $ (monoidRightIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)

What are we doing here?

First we need a way to generate random functions. That is, what this Fun thing is about. There is an Arbitrary instance for Fun a b, if there are certain instances available for a and b. But most of the time we have those.

A value of type Fun a b can be shown, so Fun a b has a show instance, provided a and b have one. We can extract the function with applyFun.

For QuickCheck to take advantage of this, we need to provide a Testable where all argument positions can be randomly generated and shown.

So we have to formulate our Properties in terms of a, b and Fun a b.

To connect all of this with Combine we provide a function from Fun a b to Combine a b.

Now we are stuck with another problem. We can't compare functions, so we can't compare values of type Combine a b for equality. As we are already randomly generating test cases, why not just generate the points, on which to test the functions for equality, also randomly. The equality will not be a sure thing, but we are hunting the falsifiable examples! So that is good enough for us. To do that, we provide a function to "apply" a value of type Combine a b to a value of type a, to get a value of type b, which can hopefully be compared for equality.

Answer 2

You can use Test.QuickCheck.Function to generate random function values, so you should be able to write something like the following to take care of the Arbitrary constraint:

quickCheck (monoidLeftIdentity1 . Combine . apply :: Fun Int (Sum Int) -> Bool)

For the Eq constraint, however, you will have trouble comparing function values. I think it should be enough to just check pointwise equality for some sampling of inputs, e.g.

funoidLeftIdentity1 :: (Monoid b, Eq b) => Fun a b -> a -> Bool
funoidLeftIdentity1 (Fn f) x = uncombine (Combine f <> mempty) x == uncombine mempty x