lawful-classes-quickcheck-0.1.2.0: src/Test/Lawful/QuickCheck.hs

{-# LANGUAGE RankNTypes #-}

-- |
-- Module:      Test.Lawful.QuickCheck
-- Description: QuickCheck support for lawful-classes
-- Copyright:   (c) 2023, Nicolas Trangez
-- License:     Apache-2.0
-- Maintainer:  ikke@nicolast.be
-- Stability:   alpha
--
-- Support code to check @lawful-classes@ laws using QuickCheck and,
-- optionally, Tasty.
module Test.Lawful.QuickCheck
  ( -- * Tasty integration
    testLaws,
    testLawsWith,

    -- * Utilities
    forAll,
    forAllShow,

    -- * Plumbing
    toProperty,
  )
where

import Control.Monad.Trans.Class (MonadTrans, lift)
import Test.Lawful.Types (Law, Laws)
import Test.QuickCheck (Gen, Property, discard)
import qualified Test.QuickCheck as Q
import Test.QuickCheck.Monadic (PropertyM (MkPropertyM), assert, monadicIO, pick)
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

-- | Given a way to evaluate an @m a@ into a base 'Monad', turn a 'Law' into a 'Property'.
toProperty :: (forall a. m a -> PropertyM IO a) -> Law m -> Property
toProperty run law = monadicIO $ maybe discard assert =<< run law

-- | Given 'Laws' for @m@ and a way to evaluate an @m a@ in @'PropertyM' IO@,
-- create a @tasty@ 'TestTree'.
testLaws :: TestName -> (forall a. m a -> PropertyM IO a) -> Laws m -> TestTree
testLaws = testLawsWith id

-- | Given 'Laws' for @m@ and a way to evaluate an @m a@ in @'PropertyT' IO@,
-- create a @tasty@ 'TestTree', modifying all created 'Property's with the
-- given function.
--
-- As an example, 'Test.QuickCheck.once' could be used to run every test only
-- once, e.g., because 'm' is not a transformer so there's no way to generate
-- multiple test exemplars using some generator, except for the trivial
-- constant generator.
--
-- @since 0.1.1.0
testLawsWith :: (Property -> Property) -> TestName -> (forall a. m a -> PropertyM IO a) -> Laws m -> TestTree
testLawsWith fn name run laws = testGroup name [testProperty n (fn $ toProperty run l) | (n, l) <- laws]

-- | Lifted version of 'pick'.
--
-- This can be used to easily create generators for laws which need them.
--
-- __Note__: like 'pick', values generated by 'forAll' do not shrink.
forAll :: (MonadTrans t, Monad m, Show a) => Gen a -> t (PropertyM m) a
forAll = lift . pick

-- | Like 'forAll', but for types without a 'Show' instance (or, for which
-- another stringification functions but 'show' should be used).
--
-- Like 'Test.QuickCheck.forAllShow', but in a monadic context.
--
-- This can be used to earily create generators for laws which need them.
--
-- __Note__: like 'forAll', values generated by 'forAllShow' do not shrink.
forAllShow :: (MonadTrans t, Monad m) => (a -> String) -> Gen a -> t (PropertyM m) a
forAllShow shw = lift . pickShow
  where
    pickShow gen = MkPropertyM $ \k -> do
      a <- gen
      mp <- k a
      return $
        Q.forAllShow (return a) shw . const <$> mp