test-framework-th-0.2.4/0000755000000000000000000000000012056641562013275 5ustar0000000000000000test-framework-th-0.2.4/BSD3.txt0000644000000000000000000000272412056641562014536 0ustar0000000000000000Copyright (c) 2010, Oscar Finnsson All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oscar Finnsson nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Oscar Finnsson BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.test-framework-th-0.2.4/Setup.lhs0000644000000000000000000000015612056641562015107 0ustar0000000000000000#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain test-framework-th-0.2.4/test-framework-th.cabal0000644000000000000000000000425412056641562017651 0ustar0000000000000000name: test-framework-th version: 0.2.4 cabal-version: >= 1.6 build-type: Simple license: BSD3 license-file: BSD3.txt maintainer: Oscar Finnsson homepage: http://github.com/finnsson/test-generator synopsis: Automagically generate the HUnit- and Quickcheck-bulk-code using Template Haskell. description: @test-framework-th@ contains two interesting functions: @defaultMainGenerator@ and @testGroupGenerator@. . @defaultMainGenerator@ will extract all functions beginning with case_, prop_ or test_in the module and put them in a testGroup. . > -- file SomeModule.hs > ( -# LANGUAGE TemplateHaskell #- ) > module SomeModule where > import Test.Framework.TH > import Test.Framework > import Test.HUnit > import Test.Framework.Providers.HUnit > import Test.Framework.Providers.QuickCheck2 > > -- observe this line! > main = $(defaultMainGenerator) > case_1 = do 1 @=? 1 > case_2 = do 2 @=? 2 > prop_reverse xs = reverse (reverse xs) == xs > where types = xs::[Int] . is the same as . > -- file SomeModule.hs > ( -# LANGUAGE TemplateHaskell #- ) > module SomeModule where > import Test.Framework.TH > import Test.Framework > import Test.HUnit > import Test.Framework.Providers.HUnit > import Test.Framework.Providers.QuickCheck2 > > -- observe this line! > main = > defaultMain [ > testGroup "SomeModule" [ testCase "1" case_1, testCase "2" case_2, testProperty "reverse" prop_reverse] > ] > > case_1 = do 1 @=? 1 > case_2 = do 2 @=? 2 > prop_reverse xs = reverse (reverse xs) == xs > where types = xs::[Int] . @testGroupGenerator@ is like @defaultMainGenerator@ but without @defaultMain@. It is useful if you need a function for the testgroup (e.g. if you want to be able to call the testgroup from another module). category: Testing author: Oscar Finnsson & Emil Nordling library exposed-modules: Test.Framework.TH build-depends: base >= 4 && < 5, test-framework, language-haskell-extract >= 0.2, haskell-src-exts, regex-posix, template-haskell hs-source-dirs: src source-repository head type: git location: https://github.com/finnsson/test-generator.git test-framework-th-0.2.4/src/0000755000000000000000000000000012056641562014064 5ustar0000000000000000test-framework-th-0.2.4/src/Test/0000755000000000000000000000000012056641562015003 5ustar0000000000000000test-framework-th-0.2.4/src/Test/Framework/0000755000000000000000000000000012056641562016740 5ustar0000000000000000test-framework-th-0.2.4/src/Test/Framework/TH.hs0000644000000000000000000001000112056641562017577 0ustar0000000000000000----------------------------------------------------------------------------- -- -- Module : MainTestGenerator -- Copyright : -- License : BSD4 -- -- Maintainer : Oscar Finnsson -- Stability : -- Portability : -- -- ----------------------------------------------------------------------------- {-# OPTIONS_GHC -XTemplateHaskell #-} module Test.Framework.TH ( defaultMainGenerator, defaultMainGenerator2, testGroupGenerator ) where import Language.Haskell.TH import Language.Haskell.Exts.Parser import Language.Haskell.Exts.Syntax import Text.Regex.Posix import Data.Maybe import Language.Haskell.Exts.Extension import Language.Haskell.Extract import Test.Framework (defaultMain, testGroup) -- | Generate the usual code and extract the usual functions needed in order to run HUnit/Quickcheck/Quickcheck2. -- All functions beginning with case_, prop_ or test_ will be extracted. -- -- > {-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-} -- > module MyModuleTest where -- > import Test.HUnit -- > import MainTestGenerator -- > -- > main = $(defaultMainGenerator) -- > -- > case_Foo = do 4 @=? 4 -- > -- > case_Bar = do "hej" @=? "hej" -- > -- > prop_Reverse xs = reverse (reverse xs) == xs -- > where types = xs :: [Int] -- > -- > test_Group = -- > [ testCase "1" case_Foo -- > , testProperty "2" prop_Reverse -- > ] -- -- will automagically extract prop_Reverse, case_Foo, case_Bar and test_Group and run them as well as present them as belonging to the testGroup 'MyModuleTest' such as -- -- > me: runghc MyModuleTest.hs -- > MyModuleTest: -- > Reverse: [OK, passed 100 tests] -- > Foo: [OK] -- > Bar: [OK] -- > Group: -- > 1: [OK] -- > 2: [OK, passed 100 tests] -- > -- > Properties Test Cases Total -- > Passed 2 3 5 -- > Failed 0 0 0 -- > Total 2 3 5 -- defaultMainGenerator :: ExpQ defaultMainGenerator = [| defaultMain [ testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator) ] |] defaultMainGenerator2 :: ExpQ defaultMainGenerator2 = [| defaultMain [ testGroup $(locationModule) $ $(caseListGenerator) ++ $(propListGenerator) ++ $(testListGenerator) ] |] -- | Generate the usual code and extract the usual functions needed for a testGroup in HUnit/Quickcheck/Quickcheck2. -- All functions beginning with case_, prop_ or test_ will be extracted. -- -- > -- file SomeModule.hs -- > fooTestGroup = $(testGroupGenerator) -- > main = defaultMain [fooTestGroup] -- > case_1 = do 1 @=? 1 -- > case_2 = do 2 @=? 2 -- > prop_p xs = reverse (reverse xs) == xs -- > where types = xs :: [Int] -- -- is the same as -- -- > -- file SoomeModule.hs -- > fooTestGroup = testGroup "SomeModule" [testProperty "p" prop_1, testCase "1" case_1, testCase "2" case_2] -- > main = defaultMain [fooTestGroup] -- > case_1 = do 1 @=? 1 -- > case_2 = do 2 @=? 2 -- > prop_1 xs = reverse (reverse xs) == xs -- > where types = xs :: [Int] -- testGroupGenerator :: ExpQ testGroupGenerator = [| testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator) |] listGenerator :: String -> String -> ExpQ listGenerator beginning funcName = functionExtractorMap beginning (applyNameFix funcName) propListGenerator :: ExpQ propListGenerator = listGenerator "^prop_" "testProperty" caseListGenerator :: ExpQ caseListGenerator = listGenerator "^case_" "testCase" testListGenerator :: ExpQ testListGenerator = listGenerator "^test_" "testGroup" -- | The same as -- e.g. \n f -> testProperty (fixName n) f applyNameFix :: String -> ExpQ applyNameFix n = do fn <- [|fixName|] return $ LamE [VarP (mkName "n")] (AppE (VarE (mkName n)) (AppE (fn) (VarE (mkName "n")))) fixName :: String -> String fixName name = replace '_' ' ' $ drop 5 name replace :: Eq a => a -> a -> [a] -> [a] replace b v = map (\i -> if b == i then v else i)