A Prototype Test Suite Library Interface

This post is Literate Haskell.

> {-# LANGUAGE ExistentialQuantification #-}
> module Distribution.Testsuite where

This requires base >= 4 for extensible exceptions.

> import Control.Exception ( SomeException, Exception(toException) )
> import Control.Monad ( liftM )
> import Data.Dynamic ( Dynamic() )
> import Data.Function ( on )
> import Data.List ( unionBy )
> import Data.Monoid ( Monoid(..) )

The use of unsafePerformIO is an unfortunate consequence of the method used to catch exceptions below.

> import System.IO.Unsafe ( unsafePerformIO )

Tests are separated based on their purity. Although it appears that any test using the RNG, i.e. all tests using QuickCheck, must be impure, the use of the RNG is actually pure if the starting seed is specified in the Options. Therefore, only tests using other sorts of IO need be impure. Hopefully, with this purity information, test agents can make more informed decisions about which tests can and cannot be run in parallel.

> data Test
>     = forall p. PureTestable p => PureTest p
>     | forall i. ImpureTestable i => ImpureTest i
> 
> class TestOptions t => ImpureTestable t where
>     getResult :: t -> Options -> IO Result
> 
> class TestOptions t => PureTestable t where
>     result :: t -> Options -> Result
> 
> class TestOptions t where
>     name :: t -> Name
>     options :: t -> [String]
>     defaultOptions :: t -> IO Options

The defaultOptions are returned in IO because it may be necessary to generate a random seed for some types of tests.

> type Name = String
> 
> newtype Options = Options [(String, Dynamic)]
>
> data Result = Pass | Fail Reason | Error SomeException
>     deriving Show
> 
> type Reason = String

The instances of the PureTestable, ImpureTestable and TestOptions classes will be left to the test libraries, e.g. HUnit and QuickCheck. It is not our purpose to reinvent the features they already provide, but to specify a uniform interface between them and test agents.

We provide a sensible instance of Monoid to allow the combination of sets of Options with the default options.

> instance Monoid Options where
>     mempty = Options []
> 
>     mappend (Options a) (Options b) =
>         Options $ unionBy ((==) `on` fst) a b

Default options go on the right argument of mappend and get overwritten by Options to the left.

What remains are some helper functions for handling options and exceptions:

> wrapException :: IO Result -> IO Result
> wrapException go = catch go $ return . Error . toException
> 
> mergeOptions :: TestOptions t => t -> Options -> IO Options
> mergeOptions test opts = liftM (mappend opts) $ defaultOptions test
> 
> runImpureTest :: ImpureTestable t => t -> Options -> IO Result
> runImpureTest = (wrapException .) . getResult
> 
> runPureTest :: PureTestable t => t -> Options -> Result
> runPureTest test opts = unsafePerformIO $ wrapException $ return $ result test opts

The use of unsafePerformIO in runPureTest is actually safe, since the function we are catching exceptions from is pure.