I have a class that has an associated monad, so that instances can be created for different monads.
class MutRef a where
type MutRefM a :: * -> *
type MutRefVal a
readMutRef :: a -> MutRefM a (MutRefVal a)
writeMutRef :: a -> MutRefVal a -> MutRefM a ()
modifyMutRef :: a -> (MutRefVal a -> MutRefVal a) -> MutRefM a ()
I would like to test these with QuickCheck
.
I want to create functions representing ‘laws,’ like so:
readsAndWrites :: (MutRef a, Monad (MutRefM a), Eq (MutRefVal a))
=> TestHarness a -> MutRefVal a -> Property
readsAndWrites (getRef, runner) a = runner $ do
a' <- run $ do
ref <- getRef
writeMutRef ref a
readMutRef ref
assert (a == a')
TestHarness
is a tuple of helper functions:
type TestHarness a = (MutRefM a a, PropertyM (MutRefM a) () -> Property)
providing the test with a ‘Ref’ to use, and turning the action into a Property
respectively.
I would then be able to instantiate a QuickCheck test property using the ‘law’ and a harness.
For IO
, this works without a problem:
ioRefTestHarness :: TestHarness (IORef Int)
ioRefTestHarness = (newIORef 0, monadicIO)
prop_ioRefReadsAndWrites :: MutRefVal (IORef Int) -> Property
prop_ioRefReadsAndWrites = readsAndWrites ioRefTestHarness
compiles and runs.
However, I also have an ST
instance:
instance MutRef (STRef s a) where
type MutRefM (STRef s a) = ST s
type MutRefVal (STRef s a) = a
readMutRef = readSTRef
writeMutRef = writeSTRef
modifyMutRef = modifySTRef
Attempting to naively define a test harness however,
stRefTestHarness :: TestHarness (STRef s Int)
stRefTestHarness = (newSTRef 0, monadicST)
fails with the error message:
• Couldn't match type ‘PropertyM (ST s) ()’
with ‘forall s1. PropertyM (ST s1) a0’
Expected type: PropertyM (MutRefM (STRef s Int)) () -> Property
Actual type: (forall s. PropertyM (ST s) a0) -> Property
• In the expression: monadicST
In the expression: (newSTRef 0, monadicST)
In an equation for ‘stRefTestHarness’:
stRefTestHarness = (newSTRef 0, monadicST)
• Relevant bindings include
stRefTestHarness :: TestHarness (STRef s Int)
(bound at test/quickcheck.hs:79:1)
I’m guessing I need a quantification somewhere, but I have not been successful out where through trial and error.
Is it possible to parameterize my harness type over ST
like this?
How do I go about what I am trying to do?