    --------------------------------------------------------------------
    -- |
    -- 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
      ((good, bad), mbEx) <- Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)
    forall a.
    Testable IO a =>
    Depth -> a -> IO ((Integer, Integer), Maybe PropertyFailure)
    runTestWithStats Depth
    d a
    a
      let testsRun = Integer
    good Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    bad
      case mbEx of
        Maybe PropertyFailure
    Nothing -> do
          String -> Integer -> IO ()
    forall r. PrintfType r => String -> r
    printf String
    "Completed %d tests without failure.\n" Integer
    testsRun
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    bad Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> Integer -> IO ()
    forall r. PrintfType r => String -> r
    printf String
    "But %d did not meet ==> condition.\n" Integer
    bad
        Just PropertyFailure
    x -> do
          String -> Integer -> IO ()
    forall r. PrintfType r => String -> r
    printf String
    "Failed test no. %d.\n" Integer
    testsRun
          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    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
      good <- Integer -> IO (IORef Integer)
    forall a. a -> IO (IORef a)
    newIORef Integer
    0
      bad <- newIORef 0

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

      r <- smallCheckWithHook d hook prop

      goodN <- readIORef good
      badN  <- readIORef bad

      return ((goodN, badN), 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
        x <- IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    ref
        let x' = a -> a
    f a
    x
        x' `seq` writeIORef ref 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 = Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
    forall (m :: * -> *) a.
    Testable m a =>
    Depth -> (TestQuality -> m ()) -> a -> m (Maybe PropertyFailure)
    smallCheckWithHook Depth
    d (m () -> TestQuality -> m ()
    forall a b. a -> b -> a
    const (m () -> TestQuality -> m ()) -> m () -> TestQuality -> m ()
    forall a b. (a -> b) -> a -> b
    $ () -> m ()
    forall a. a -> m a
    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 = Depth
    -> (TestQuality -> m ()) -> Property m -> m (Maybe PropertyFailure)
    forall (m :: * -> *).
    Monad m =>
    Depth
    -> (TestQuality -> m ()) -> Property m -> m (Maybe PropertyFailure)
    runProperty Depth
    d TestQuality -> m ()
    hook (Property m -> m (Maybe PropertyFailure))
    -> Property m -> m (Maybe PropertyFailure)
    forall a b. (a -> b) -> a -> b
    $ a -> Property m
    forall (m :: * -> *) a. Testable m a => a -> Property m
    test a
    a