Note: This is using (at the time of writing) the latest developmental version of Deja Fu, which is not yet on hackage. It will be soon! But until then, if you want to replicate this, clone from git.

I recently implemented async-dejafu, a version of the async library using Deja Fu so programs written with it can be tested, and I was curious about checking the relevant typeclass laws automatically.

Checking typeclass laws has been done with QuickCheck before, but the difference here is that async uses concurrency! If only we had some way to test concurrent Haskell code! Oh, wait…

The set-up

Specifically, I want to test the laws for the Concurrently type. Concurrently is a monad for expressing IO actions which should be run concurrently.

Firstly, we need some language extensions and imports:

{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Concurrently where import Control.Applicative import Control.Exception ( SomeException ) import Control.Monad (( >=> ), ap , liftM , forever ) import Control.Monad.Catch ( onException ) import Control.Monad.Conc.Class import Data.Maybe ( isJust ) import Data.Set ( Set , fromList ) import Test.DejaFu ( Failure ( .. ), defaultMemType ) import Test.DejaFu.Deterministic ( ConcST , Trace ) import Test.DejaFu.SCT ( sctBound , defaultBounds ) import Test.QuickCheck ( Arbitrary ( .. )) import Test.QuickCheck.Function ( Fun , apply ) import Unsafe.Coerce ( unsafeCoerce )

I have sadly not managed to eliminate that unsafeCoerce , it shows up because of the use of higher-ranked types, and makes me very sad. If anyone knows how I can get rid of it, I would be very happy!

Now we need our Concurrently type. The original just uses IO , so we have to parameterise ours over the underlying monad:

newtype Concurrently m a = Concurrently { runConcurrently :: m a }

We’ll also be using a ConcST variant for testing a lot, so here’s a type synonym for that:

type CST t = Concurrently ( ConcST t )

We also need some instances for Concurrently in order to make QuickCheck happy, but these aren’t terribly important:

instance Show ( Concurrently m a ) where show _ = "<concurrently>" instance ( Arbitrary a , Applicative m ) => Arbitrary ( Concurrently m a ) where arbitrary = Concurrently . pure <$> arbitrary

Ok, let’s get started!

Functor

Functor lets you apply a pure function to a value in a context.

class Functor f where fmap :: ( a -> b ) -> f a -> f b

A Functor should satisfy the identity law:

fmap id = id

And the composition law:

fmap f . fmap g = fmap ( f . g )

The Functor instance for Concurrently just delegates the work to the instance for the underlying monad:

instance MonadConc m => Functor ( Concurrently m ) where fmap f ( Concurrently a ) = Concurrently $ f <$> a

The composition law is a little awkward to express in a way that QuickCheck can deal with, as it involves arbitrary functions. QuickCheck has a Fun type, representing functions which can be serialised to a string. Bearing that in mind, here is how we can express those two laws as tests:

prop_functor_id :: Ord a => CST t a -> Bool prop_functor_id ca = ca ` eq ` ( id <$> ca ) prop_functor_comp :: Ord c => CST t a -> Fun a b -> Fun b c -> Bool prop_functor_comp ca ( apply -> f ) ( apply -> g ) = ( g . f <$> ca ) ` eq ` ( g <$> ( f <$> ca ))

We’re using view patterns here to extract the actual function from the Fun value. let’s see if the laws hold!

λ> quickCheck ( prop_functor_id :: CST t Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_functor_comp :: CST t Int -> Fun Int Integer -> Fun Integer String -> Bool ) +++ OK, passed 100 tests.

Cool! Wait, what’s that eq function?

Equality and concurrency?

I’ve decided to treat two concurrent computations as equal if the sets of values that they can produce are equal:

eq :: Ord a => CST t a -> CST t a -> Bool eq left right = runConcurrently left ` eq' ` runConcurrently right eq' :: forall t a . Ord a => ConcST t a -> ConcST t a -> Bool eq' left right = results left == results right where results cst = fromList . map fst $ sctBound' cst sctBound' :: ConcST t a -> [( Either Failure a , Trace )] sctBound' = unsafeCoerce $ sctBound defaultMemType defaultBounds

This is where the unfortunate unsafeCoerce comes in. The definition of sctBound' there doesn’t type-check without it, which is a shame. If anyone could offer a solution, I would be very grateful.

Applicative

Applicative extends Functor with the ability to inject a value into a context without introducing any effects, and to apply a function in a context to a value in a context.

class Functor f => Applicative f where pure :: a -> f a ( <*> ) :: f ( a -> b ) -> f a -> f b

An Applicative should satisfy the identity law:

pure id <*> a = a

The homomorphism law, which says that applying a pure function to a pure value in a context is the same as just applying the function to the value and injecting the entire result into a context:

pure ( f a ) = pure f <*> pure a

The interchange law, which says that when applying a function in a context to a pure value, the order in which each is evaluated doesn’t matter:

u <*> pure y = pure ( $ y ) <*> u

And the composition law, which is a sort of associativity property:

u <*> ( v <*> w ) = pure ( . ) <*> u <*> v <*> w

Finally, there is a law relating Applicative to Functor , that says we can decompose fmap into two steps, injecting a function into a context, and then application within that context:

f <$> x = pure f <*> x

This is where Concurrently gets its concurrency. (<*>) runs its two arguments concurrently, killing the other if one throws an exception.

instance MonadConc m => Applicative ( Concurrently m ) where pure = Concurrently . pure Concurrently fs <*> Concurrently as = Concurrently $ ( \ ( f , a ) -> f a ) <$> concurrently fs as concurrently :: MonadConc m => m a -> m b -> m ( a , b ) concurrently = ...

Armed with the knowledge of how to generate arbitrary functions, these are all fairly straight-forward to test

prop_applicative_id :: Ord a => CST t a -> Bool prop_applicative_id ca = ca ` eq ` ( pure id <*> ca ) prop_applicative_homo :: Ord b => a -> Fun a b -> Bool prop_applicative_homo a ( apply -> f ) = ( pure $ f a ) ` eq ` ( pure f <*> pure a ) prop_applicative_inter :: Ord b => CST t ( Fun a b ) -> a -> Bool prop_applicative_inter u y = ( u' <*> pure y ) ` eq ` ( pure ( $ y ) <*> u' ) where u' = apply <$> u prop_applicative_comp :: Ord c => CST t ( Fun b c ) -> CST t ( Fun a b ) -> CST t a -> Bool prop_applicative_comp u v w = ( u' <*> ( v' <*> w )) ` eq ` ( pure ( . ) <*> u' <*> v' <*> w ) where u' = apply <$> u v' = apply <$> v prop_applicative_fmap :: Ord b => Fun a b -> CST t a -> Bool prop_applicative_fmap ( apply -> f ) a = ( f <$> a ) ` eq ` ( pure f <*> a )

And indeed we see that the laws hold:

λ> quickCheck ( prop_applicative_id :: CST t Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_applicative_homo :: String -> Fun String Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_applicative_inter :: CST t ( Fun Int String ) -> Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_applicative_comp :: CST t ( Fun Int String ) -> CST t ( Fun Char Int ) -> CST t Char -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_applicative_fmap :: Fun Int String -> CST t Int -> Bool ) +++ OK, passed 100 tests.

Alternative

Alternative is a kind of monoid over Applicative .

class Applicative f => Alternative f where empty :: f a ( <|> ) :: f a -> f a -> f a -- These both have default definitions some :: f a -> f [ a ] many :: f a -> f [ a ]

An Alternative should satisfy the monoid laws. Namely, left and right identity:

empty <|> x = x x <|> empty = x

And associativity:

( x <|> y ) <|> z = x <|> ( y <|> z )

The Alternative instance for Concurrently is used to express races, with (<|>) executing both of its arguments concurrently and returning the first to finish:

instance MonadConc m => Alternative ( Concurrently m ) where empty = Concurrently $ forever yield Concurrently as <|> Concurrently bs = Concurrently $ either id id <$> race as bs race :: MonadConc m => m a -> m b -> m ( Either a b ) race = ...

Once again, the translation into QuickCheck properties is quite simple:

prop_alternative_right_id :: Ord a => CST t a -> Bool prop_alternative_right_id x = x ` eq ` ( x <|> empty ) prop_alternative_left_id :: Ord a => CST t a -> Bool prop_alternative_left_id x = x ` eq ` ( empty <|> x ) prop_alternative_assoc :: Ord a => CST t a -> CST t a -> CST t a -> Bool prop_alternative_assoc x y z = ( x <|> ( y <|> z )) ` eq ` (( x <|> y ) <|> z )

And the laws hold!

λ> quickCheck ( prop_alternative_right_id :: CST t Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_alternative_left_id :: CST t Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_alternative_assoc :: CST t Int -> CST t Int -> CST t Int -> Bool ) +++ OK, passed 100 tests.

There are also some laws relating Alternative to Applicative , but these are expressed in terms of some and many , which have default law-satisfying definitions.

Monad

Monad extends Applicative with the ability to squash nested monadic values together, and are commonly used to express sequencing.

class Applicative m => Monad m where return :: a -> m a ( >>= ) :: m a -> ( a -> m b ) -> m b

There are a few different formulations of the Monad laws, I prefer the one in terms of (>=>) (the fish operator), which is defined as:

( >=> ) :: Monad m => ( a -> m b ) -> ( b -> m c ) -> a -> m c f >=> g = \ x -> f x >>= g

Using this function the laws become simply the monoid laws:

return >=> f = f f >=> return = f ( f >=> g ) >=> h = f >=> ( g >=> h )

There are also a few laws relating Monad to Applicative and Functor :

f <$> a = f ` liftM ` a return = pure ( <*> ) = ap

As with the Functor , the Monad instance just delegates the work:

instance MonadConc m => Monad ( Concurrently m ) where return = pure Concurrently a >>= f = Concurrently $ a >>= runConcurrently . f

As these laws are mostly about function equality, a helper function to express that is used:

eqf :: Ord b => ( a -> CST t b ) -> ( a -> CST t b ) -> a -> Bool eqf left right a = left a ` eq ` right a

Given that, the translation is simple:

prop_monad_left_id :: Ord b => Fun a ( CST t b ) -> a -> Bool prop_monad_left_id ( apply -> f ) = f ` eqf ` ( return >=> f ) prop_monad_right_id :: Ord b => Fun a ( CST t b ) -> a -> Bool prop_monad_right_id ( apply -> f ) = f ` eqf ` ( f >=> return ) prop_monad_comp :: Ord d => Fun a ( CST t b ) -> Fun b ( CST t c ) -> Fun c ( CST t d ) -> a -> Bool prop_monad_comp ( apply -> f ) ( apply -> g ) ( apply -> h ) = (( f >=> g ) >=> h ) ` eqf ` ( f >=> ( g >=> h )) prop_monad_fmap :: Ord b => Fun a b -> CST t a -> Bool prop_monad_fmap ( apply -> f ) a = ( f <$> a ) ` eq ` ( f ` liftM ` a ) prop_monad_pure :: Ord a => a -> Bool prop_monad_pure = pure ` eqf ` return prop_monad_ap :: Ord b => Fun a b -> a -> Bool prop_monad_ap ( apply -> f ) a = ( pure f <*> pure a ) ` eq ` ( return f ` ap ` return a )

Are there any counterexamples? No there aren’t!

λ> quickCheck ( prop_monad_left_id :: Fun Int ( CST t String ) -> Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_monad_right_id :: Fun Int ( CST t String ) -> Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_monad_comp :: Fun Int ( CST t String ) -> Fun String ( CST t Bool ) -> Fun Bool ( CST t Int ) -> Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_monad_fmap :: Fun Int String -> CST t Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_monad_pure :: Int -> Bool ) +++ OK, passed 100 tests. λ> quickCheck ( prop_monad_ap :: Fun Int String -> Int -> Bool ) +++ OK, passed 100 tests.

So, it certainly looks like all the laws hold! Yay!

What about effects?

Consider the eq' function. This sort of “value-level” equality is good enough for most types, where any type of effect is a value, but it doesn’t work so well when concurrency (or any sort of IO ) is involved, as there effects do not directly correspond to values.

There’s one type of effect we particularly care about for the case of Concurrently : namely, the amount of concurrency going on! To test this, we need to write our tests such that different amounts of concurrency can produce different results, which means our current Arbitrary instance for Concurrently isn’t good enough. We need interaction between different concurrent inputs.

So let’s try writing a test case for the (<*>) = ap law, but explicitly testing the amount of concurrency:

prop_monad_ap2 :: forall a b . Ord b => Fun a b -> Fun a b -> a -> Bool prop_monad_ap2 ( apply -> f ) ( apply -> g ) a = go ( <*> ) ` eq' ` go ap where go :: ( CST t ( a -> b ) -> CST t a -> CST t b ) -> ConcST t b go combine = do var <- newEmptyCVar let cf = do { res <- tryTakeCVar var ; pure $ if isJust res then f else g } let ca = do { putCVar var () ; pure a } runConcurrently $ Concurrently cf ` combine ` Concurrently ca

Here we have two functions, f and g , and are using whether a CVar is full or empty to choose between them. If the combining function executes its arguments concurrently, then we will see both cases; otherwise we’ll only see the g case. If the law holds, and (<*>) = ap , then we will see both cases for both of them!

λ> quickCheck ( prop_monad_ap2 :: Fun Int String -> Fun Int String -> Int -> Bool ) *** Failed! Falsifiable ( after 3 tests and 8 shrinks ) : { _-> "" } { _-> "a" } 0

Oops! We found a counterexample! Let’s see what’s happening:

λ> results $ go ( <*> ) ( \_ -> "" ) ( \_ -> "a" ) 0 fromList [ Right "" ,Right "a" ] λ> results $ go ap ( \_ -> "" ) ( \_ -> "a" ) 0 fromList [ Right "a" ]

If we look at the definition of ap , the problem becomes clear:

ap :: Monad m => m ( a -> b ) -> m a -> m b ap mf ma = mf >>= \ f -> ma >>= \ a -> return ( f a )

The issue is that our definiton of (>>=) is sequential, whereas (<*>) is concurrent. The Monad instance is not consistent with that Applicative when there is interaction between actions, as this shows!

So what’s the problem? It’s close enough, right? Well, close enough isn’t good enough, when it comes to laws. This very issue caused breakage, and is the reason that the Monad instance for Concurrently got removed!

So what?

So what’s the point of this? Big deal, laws are important.

Well, that is the point. Laws are important, but often we don’t bother to test them. That’s possibly fine if the instances are simple, and you can check the laws by just juggling definitions in your head, but when IO is involved, the situation becomes a bit more murky.