{-# LANGUAGE TemplateHaskell #-} | |
-- An example of testing TH-generated thingadoohickies. | |
-- | |
-- Using the standard QuickCheck module, there is no direct way to test | |
-- values generated with Template Haskell functions, most of which end up | |
-- in the Q monad. This little writeup describes how to test those values | |
-- using the module Test.QuickCheck.Monadic. | |
-- | |
-- For this example, you can ignore the doohickies being generated. I just | |
-- ripped them verbatim from the code that motivated this journey of | |
-- discovery. EXCEPT! One important thing about these doohickies is that | |
-- they don't use any of the name-mangling which is Q's raison d'être. | |
-- Were they to use it, it might be trickier (but not impossible?) to test | |
-- equality. | |
import Control.Monad ((=<<), liftM2) | |
import Language.Haskell.TH | |
import Test.QuickCheck | |
import Test.QuickCheck.Monadic | |
-- | One method of generating a thingadoohickie: | |
mkBoolFlagsOld :: [String] -> Q Dec | |
mkBoolFlagsOld flags = | |
dataD (cxt []) (mkName "BoolFlags") [] [dCon flags] [mkName "Show"] | |
where | |
dCon :: [String] -> ConQ | |
dCon = recC (mkName "BoolFlags") . map mkBoolRec | |
mkBoolRec :: String -> VarStrictTypeQ | |
mkBoolRec flag = do | |
bool <- [t|Bool|] | |
return (mkName flag, NotStrict, bool) | |
-- | Another method of generating the same(?) thingadoohickie: | |
mkBoolFlagsNew :: [String] -> Q Dec | |
mkBoolFlagsNew = mkFlags (mkName "BoolFlags") [t|Bool|] | |
where | |
mkFlags name typ flags = dataD (cxt []) name [] [dCon' name typ flags] [mkName "Show"] | |
dCon' name typ = recC name . map (mkTypRec typ) | |
mkTypRec typ flag = typ >>= (\t -> return $ (mkName flag, NotStrict, t)) | |
-- So now there are two methods of generating the thing, both of type | |
-- [String] -> Q Dec. | |
-- | |
-- I want to test the property that given the same input, these functions | |
-- return the same output. | |
-- | |
-- Since their output is in the Q monad, I have to instruct QuickCheck on | |
-- how to set up the monadic 'environment' to ensure consistency between | |
-- the various runs. "Test.QuickCheck.Monadic" provides a framework for | |
-- doing this. | |
-- | |
-- Now, there is more than one way to do this (many more, in fact), but I'll | |
-- start off with a property that looks similar to what I'd write in the | |
-- absence of monads: | |
propQ_same :: [String] -> Q Bool | |
propQ_same ss = (liftM2 (==)) (mkBoolFlagsOld ss) (mkBoolFlagsNew ss) | |
-- With no monads, I'd drop the liftM2 and be done. With monads, however, I | |
-- have to explicitly set up and run the proper environment. In my case, | |
-- the environment doesn't actually matter (see above), but to make the types | |
-- work I still need to stuff my property into the PropertyM monad. This is | |
-- accomplished with 'run': | |
propM_same_PROBLEM :: [String] -> PropertyM Q Bool | |
propM_same_PROBLEM = run . propQ_same | |
-- But wait! Now I have to think about running the PropertyM monad, and at | |
-- this point I have a problem. | |
-- | |
-- There are three ways to run PropertyM. One is general, one is | |
-- specialized to m = IO, and one is specialized to m = ST. The ST version | |
-- is not the one I want. The general method seems appealing, but that | |
-- method needs to know how to 'unwrap' a monad. In the case of Q, such a | |
-- thing is not possible. That leaves the IO-specialized function, which is | |
-- called monadicIO and has type PropertyM IO a -> Property. | |
-- | |
-- So let's see. I have PropertyM Q a, and I want PropertyM IO a. If I | |
-- could just convert Q to IO... and I can! The function to use is | |
-- | |
-- runQ :: Quasi m => Q a -> m a. | |
-- | |
-- There is a Quasi instance for IO! | |
-- | |
-- Inserting runQ before run, I get: | |
propM_same :: [String] -> PropertyM IO Bool | |
-- ^ (Specializing to IO is not precisely necessary here, as it would be | |
-- inferred later, but I'll add it for clarity.) | |
propM_same = run . runQ . propQ_same | |
-- Finally, I use monadicIO to create a property that can be tested by | |
-- quickCheck. I.e., I create something that is an instance of Testable: | |
prop_same :: [String] -> Property | |
prop_same = monadicIO . propM_same | |
-- And the test! | |
main = quickCheck prop_same | |
-- So to summarize, *one* way to test properties in the Q monad is to convert | |
-- the Q to IO with 'runQ', stuff that result into PropertyM, and then run | |
-- the whole lot with 'monadicIO'. | |
-- | |
-- Sources: | |
-- | |
-- Template Haskell: | |
-- http://www.haskell.org/haskellwiki/Template_Haskell | |
-- | |
-- QuickCheck for monadic values: | |
-- http://hackage.haskell.org/packages/archive/QuickCheck/latest/doc/html/Test-QuickCheck-Monadic.html | |
-- | |
-- "Testing Monadic Code with QuickCheck": | |
-- http://www.cse.chalmers.se/~rjmh/Papers/QuickCheckST.ps |
This comment has been minimized.
Show comment
Hide comment
This comment has been minimized.
Show comment Hide comment
sri-prasanna
commented
Aug 12, 2015
Hey. Sorry. But, I could not get this code to work. Change to either
Maybe I am missing something? thanks |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Hey. Sorry. But, I could not get this code to work. Change to either
mkBoolFlagsOld
ormkBoolFlagsNew
, (like Strict/NotStrict or TypeClass names) don't seem to fail the test as I expected. So, I came up with something like below:Maybe I am missing something? thanks