I'm currently writing a QuickCheck style library and relying on Template Haskell for generating a large number of test cases.
I want to generate code like:
quickCheck (prop_Num_plus_is_associative :: Integer -> Integer -> Integer -> Property)
The property "prop_Monoid_plus_is_associative" has the following type:
prop_Num_plus_is_associative :: (Eq a, Monoid a, Show a) => a -> a -> a -> Property
so that I can check it with any appropriate instance of Monoid
. However, sometimes, the types that my program chooses to fill in for "a" does not satisfy the context. I would like to filter out those cases by checking whether a certain instance exists.
However, when I call reifyInstance
on Monoid (Max Integer)
, it only gives me the list of instances that it could possibly match, namely (Bounded a, Ord a) => Monoid (Max a)
, it does not do the rest of the work of checking whether Integer
is Bounded
and Ord
. Is there a function similar to reifyInstance
that does?
Edit:
Here the program that I was hinting at:
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
import Data.Semigroup
import Language.Haskell.TH
main :: IO ()
main = do
$(do
tMaxInt <- [t| Max Integer |]
runIO . putStrLn . pprint =<< reifyInstances ''Monoid [ tMaxInt ]
[e| return () |] )
It outputs
instance (GHC.Classes.Ord a_0,
GHC.Enum.Bounded a_0) => GHC.Base.Monoid (Data.Semigroup.Max a_0)
despite the fact that Max Integer
is not a Monoid
.