HoistPropertyM.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}

{-# OPTIONS_GHC -Wall #-}

import           Control.Monad.Reader
import           Data.Coerce

import           Test.QuickCheck.Gen
import           Test.QuickCheck.Monadic

hoistGen :: (forall x. n x -> m x) -> Gen (n a) -> Gen (m a)
hoistGen nat (MkGen f) = MkGen $ \gen -> nat . f gen

hoistPropertyM :: (forall x. n x -> m x)
               -> (forall x. m x -> n x)
               -> PropertyM n a -> PropertyM m a
hoistPropertyM nat natInv (MkPropertyM f) = MkPropertyM $ \g ->
    hoistGen nat $ f $ hoistGen natInv . g

hoistLiftedPropertyM :: (MonadTrans t, Monad m, Coercible n (t m))
                     => (forall x. t m x -> m x)
                     -> PropertyM n a -> PropertyM m a
hoistLiftedPropertyM lower = hoistPropertyM lower lift . coerce

hoistReaderPropertyM :: (Monad m, Coercible n (ReaderT r m))
                     => r -> PropertyM n a -> PropertyM m a
hoistReaderPropertyM r = hoistLiftedPropertyM (`runReaderT` r)