Fine-grained run-time control of SmallCheck depth with Tasty

test.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, DeriveDataTypeable #-}

import Test.Tasty
import Test.Tasty.Providers
import Test.Tasty.Options
import Test.Tasty.SmallCheck
import Test.Tasty.Runners
import Test.SmallCheck.Series
import Control.Applicative
import Data.Tagged
import Data.Proxy
import Data.Monoid
import Data.Typeable

data T1 = T1 { p1 :: Int,
               p2 :: Char,
               p3 :: Int
             } deriving (Eq, Show)

newtype AskOptions t = AskOptions (OptionSet -> TestTree)
  deriving Typeable

instance IsTest t => IsTest (AskOptions t) where
  testOptions = retag (testOptions :: Tagged t [OptionDescription])
  run opts (AskOptions f) cb =
    case f opts of
      SingleTest _ t -> run opts t cb
      _ -> error "Bad TestTree"

askOptions :: (OptionSet -> TestTree) -> TestTree
askOptions f =
  case f mempty of
    SingleTest name (_ :: t) -> SingleTest name (AskOptions f :: AskOptions t)
    _ -> error "Bad TestTree"

newtype P1Depth = P1Depth { getP1Depth :: Int }
  deriving Typeable

instance IsOption P1Depth where
  defaultValue = P1Depth 5
  parseValue = fmap P1Depth . safeRead
  optionName = return "smallcheck-depth-p1"
  optionHelp = return "Depth to use for p1"

t1Series
  :: Monad m
  => Int -- depth of p1
  -> Series m T1
t1Series d = decDepth $
  T1 <$> localDepth (const d) series <~> series <~> series

main :: IO ()
main = defaultMainWithIngredients (optsIng : defaultIngredients) tests
  where
    optsIng = TestManager [Option (Proxy :: Proxy P1Depth)] (\_ _ -> Nothing)

tests :: TestTree
tests = testGroup "Tests" [scProps]

scProps = testGroup "(checked by SmallCheck)"
  [ test1
  ]

test1 =
  askOptions $ \opts ->
    testProperty "Test1" $
      over (t1Series (getP1Depth $ lookupOption opts)) $
        \x -> x == x

Would be really nice if this were built into Tasty.

The current test suite for https://github.com/runeksvendsen/order-graph takes 80 seconds to complete (on my Macbook Pro) at depth 4, and 4 milliseconds at depth 3. I'd very much welcome having a setting that results in a running time somewhere in-between these extremes.