{-# LANGUAGE QuasiQuotes, TemplateHaskell #-} {-| Template Haskell to generate defaultMain with a list of "Test" from \"doc_test\", \"case_\<somthing\>\", and \"prop_\<somthing\>\". An example of source code (Data/MySet.hs): > { -| Creating a set from a list. O(N log N) > > >>> empty == fromList [] > True > >>> singleton 'a' == fromList ['a'] > True > >>> fromList [5,3,5] == fromList [5,3] > True > - } > > fromList :: Ord a => [a] -> RBTree a > fromList = foldl' (flip insert) empty The spaces of comment symbols are due to limitation of haddock. An example of test code in the src directory (test/Test.hs): > { -# LANGUAGE TemplateHaskell #- } > module Main where > > import Test.Framework.TH.Prime > import Test.Framework.Providers.DocTest > import Test.Framework.Providers.HUnit > import Test.Framework.Providers.QuickCheck2 > import Test.QuickCheck2 > import Test.HUnit > > import Data.MySet > > main :: IO () > main = $(defaultMainGenerator) > > doc_test :: DocTests > doc_test = docTest ["../Data/MySet.hs"] ["-i.."] > > prop_toList :: [Int] -> Bool > prop_toList xs = ordered ys > where > ys = toList . fromList $ xs > ordered (x:y:xys) = x <= y && ordered (y:xys) > ordered _ = True > > case_ticket4242 :: Assertion > case_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [0,2,5,1,6,4,8,9,7,11,10,3]) @?= True And run: > test% runghc -i.. Test.hs "defaultMainGenerator" generates the following: > main = do > TestGroup _ doctests <- docTest ["../Data/MySet.hs"] ["-i.."] > defaultMain [ > testGroup "Doc tests" doctests > , testGroup "Unit tests" [ > testCase "case_ticket4242" case_ticket4242 > ] > , testGroup "Property tests" [ > testProperty "prop_toList" prop_toList > ] > ] Note: examples in haddock document is only used as unit tests at this moment. I hope that properties of QuickCheck2 can also be specified in haddock document in the future. I guess it's Haskell way of Behavior Driven Development. -} module Test.Framework.TH.Prime ( defaultMainGenerator , DocTests ) where import Control.Applicative import Language.Haskell.TH hiding (Match) import Language.Haskell.TH.Syntax hiding (Match) import Test.Framework (defaultMain) import Test.Framework.Providers.API import Test.Framework.TH.Prime.Parser ---------------------------------------------------------------- -- | Type for \"doc_test\". type DocTests = IO Test ---------------------------------------------------------------- {-| Generating defaultMain with a list of "Test" from \"doc_test\", \"case_*\", and \"prop_\". -} defaultMainGenerator :: ExpQ defaultMainGenerator = do defined <- isDefined docTestKeyword if defined then [| do TestGroup _ doctests <- $(docTests) let (unittests, proptests) = $(unitPropTests) defaultMain [ testGroup "Doc tests" doctests , testGroup "Unit tests" unittests , testGroup "Property tests" proptests ] |] else [| do let (unittests, proptests) = $(unitPropTests) defaultMain [ testGroup "Unit tests" unittests , testGroup "Property tests" proptests ] |] ---------------------------------------------------------------- -- code from Hiromi Ishii isDefined :: String -> Q Bool isDefined n = return False `recover` do VarI (Name _ flavour) _ _ _ <- reify (mkName n) modul <- loc_module <$> location case flavour of NameG ns _ mdl -> return (ns == VarName && modString mdl == modul) _ -> return False ---------------------------------------------------------------- docTestKeyword :: String docTestKeyword = "doc_test" docTests :: ExpQ docTests = return $ symbol docTestKeyword