3

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.

simon1505475
  • 675
  • 3
  • 9
  • Could you post an example program? I couldn't reproduce. (in fact, I couldn't make `reifyInstances` working at all) – sinan Nov 15 '15 at 01:27
  • TH is not going to do constraint unification. You should not try to check complex constraints like this yourself - just insert constraints for a fixed set of types which you know are monoids (or allow the user to specify which monoids to use, indicating they must submit valid `Monoid`s). – user2407038 Nov 15 '15 at 20:48

0 Answers0