--------------------------------------------------------------------
-- |
-- Module    : Test.SmallCheck.Drivers
-- Copyright : (c) Colin Runciman et al.
-- License   : BSD3
-- Maintainer: Roman Cheplyaka <roma@ro-che.info>
--
-- You should only need this module if you wish to create your own way to
-- run SmallCheck tests
--------------------------------------------------------------------

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#endif

module Test.SmallCheck.Drivers (
  smallCheck, smallCheckM, smallCheckWithHook,
  test,
  ppFailure,
  PropertyFailure(..), PropertySuccess(..), Argument, Reason, TestQuality(..)
  ) where

import Control.Monad (when, return)
import Data.Function (($), (.), const)
import Data.IORef (readIORef, writeIORef, IORef, newIORef) -- NB: explicit import list to avoid name clash with modifyIORef'
import Data.Maybe (Maybe(Nothing, Just))
import Data.Ord ((>))
import Prelude (Integer, (+), seq)
import System.IO (IO, putStrLn)
import Test.SmallCheck.Property
import Test.SmallCheck.Property.Result
import Text.Printf (printf)

-- | A simple driver that runs the test in the 'IO' monad and prints the
-- results.
--
-- @since 1.0
smallCheck :: Testable IO a => Depth -> a -> IO ()
smallCheck :: forall a. Testable IO a => Depth -> a -> IO ()
smallCheck Depth
d a
a = do
  ((Integer
good, Integer
bad), Maybe PropertyFailure
mbEx) <- forall a.
Testable IO a =>
Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)
runTestWithStats Depth
d a
a
  let testsRun :: Integer
testsRun = Integer
good forall a. Num a => a -> a -> a
+ Integer
bad
  case Maybe PropertyFailure
mbEx of
    Maybe PropertyFailure
Nothing -> do
      forall r. PrintfType r => String -> r
printf String
"Completed %d tests without failure.\n" Integer
testsRun
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
bad forall a. Ord a => a -> a -> Bool
> Integer
0) forall a b. (a -> b) -> a -> b
$
        forall r. PrintfType r => String -> r
printf String
"But %d did not meet ==> condition.\n" Integer
bad
    Just PropertyFailure
x -> do
      forall r. PrintfType r => String -> r
printf String
"Failed test no. %d.\n" Integer
testsRun
      String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PropertyFailure -> String
ppFailure PropertyFailure
x

runTestWithStats :: Testable IO a => Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)
runTestWithStats :: forall a.
Testable IO a =>
Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)
runTestWithStats Depth
d a
prop = do
  IORef Integer
good <- forall a. a -> IO (IORef a)
newIORef Integer
0
  IORef Integer
bad <- forall a. a -> IO (IORef a)
newIORef Integer
0

  let
    hook :: TestQuality -> IO ()
hook TestQuality
GoodTest = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Integer
good (forall a. Num a => a -> a -> a
+Integer
1)
    hook TestQuality
BadTest  = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Integer
bad  (forall a. Num a => a -> a -> a
+Integer
1)

  Maybe PropertyFailure
r <- forall (m :: * -> *) a.
Testable m a =>
Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
smallCheckWithHook Depth
d TestQuality -> IO ()
hook a
prop

  Integer
goodN <- forall a. IORef a -> IO a
readIORef IORef Integer
good
  Integer
badN  <- forall a. IORef a -> IO a
readIORef IORef Integer
bad

  forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer
goodN, Integer
badN), Maybe PropertyFailure
r)

-- NB: modifyIORef' is in base starting at least from GHC 7.6.1.
--
-- So get rid of this once 7.6.1 becomes widely adopted.
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' :: forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef a
ref a -> a
f = do
    a
x <- forall a. IORef a -> IO a
readIORef IORef a
ref
    let x' :: a
x' = a -> a
f a
x
    a
x' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref a
x'

-- | Use this if:
--
-- * You need to run a test in a monad different from 'IO'
--
-- * You need to analyse the results rather than just print them
--
-- @since 1.0
smallCheckM :: Testable m a => Depth -> a -> m (Maybe PropertyFailure)
smallCheckM :: forall (m :: * -> *) a.
Testable m a =>
Depth -> a -> m (Maybe PropertyFailure)
smallCheckM Depth
d = forall (m :: * -> *) a.
Testable m a =>
Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
smallCheckWithHook Depth
d (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Like `smallCheckM`, but allows to specify a monadic hook that gets
-- executed after each test is run.
--
-- Useful for applications that want to report progress information to the
-- user.
--
-- @since 1.0
smallCheckWithHook :: Testable m a => Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
smallCheckWithHook :: forall (m :: * -> *) a.
Testable m a =>
Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
smallCheckWithHook Depth
d TestQuality -> m ()
hook a
a = forall (m :: * -> *).
Monad m =>
Depth
-> (TestQuality -> m ()) -> Property m -> m (Maybe PropertyFailure)
runProperty Depth
d TestQuality -> m ()
hook forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Testable m a => a -> Property m
test a
a