tasty-th 0.1.3 → 0.1.4

raw patch · 3 files changed

+81/−78 lines, 3 filesdep −language-haskell-extract

Dependencies removed: language-haskell-extract

Files

• BSD3.txt +1/−1
• src/Test/Tasty/TH.hs +76/−73
• tasty-th.cabal +4/−4

@@ -1,5 +1,5 @@ Copyright (c) 2010, Oscar Finnsson-Copyright (c) 2013-2014, Benno Fünfstück+Copyright (c) 2013-2016, Benno Fünfstück All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -12,103 +12,106 @@ ----------------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell #-} +-- | This module provides TemplateHaskell functions to automatically generate+-- tasty TestTrees from specially named functions. See the README of the package+-- for examples.+--+-- Important: due to to the GHC staging restriction, you must put any uses of these+-- functions at the end of the file, or you may get errors due to missing definitions. module Test.Tasty.TH   ( testGroupGenerator   , defaultMainGenerator+  , testGroupGeneratorFor+  , defaultMainGeneratorFor+  , extractTestFunctions+  , locationModule   ) where +import Control.Monad (join)+import Control.Applicative import Language.Haskell.TH-import Language.Haskell.Extract+import Data.List+import Data.Maybe  import Test.Tasty+import Prelude --- | 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.+-- | Convenience function that directly generates an `IO` action that may be used as the+-- main function. It's just a wrapper that applies 'defaultMain' to the 'TestTree' generated+-- by 'testGroupGenerator'. ----- > {-# 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--- > ]+-- Example usage: ----- 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+-- @+-- -- properties, test cases, .... ----- > 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+-- main :: IO ()+-- main = $('defaultMainGenerator')+-- @ defaultMainGenerator :: ExpQ-defaultMainGenerator =-  [| defaultMain $ testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator)|]+defaultMainGenerator = [| defaultMain $(testGroupGenerator) |] --- | 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.+-- | This function generates a 'TestTree' from functions in the current module. +-- The test tree is named after the current module. -----   > -- 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]+-- The following definitions are collected by `testGroupGenerator`: -----   is the same as+-- * a test_something definition in the current module creates a sub-testGroup with the name "something"+-- * a prop_something definition in the current module is added as a QuickCheck property named "something"+-- * a case_something definition leads to a HUnit-Assertion test with the name "something" -----   > -- file SomeModule.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]+-- Example usage:+--+-- @+-- prop_example :: Int -> Int -> Bool+-- prop_example a b = a + b == b + a+--+-- tests :: 'TestTree'+-- tests = $('testGroupGenerator')+-- @ testGroupGenerator :: ExpQ-testGroupGenerator =-  [| testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator) |]--listGenerator :: String -> String -> ExpQ-listGenerator beginning funcName =-  functionExtractorMap beginning (applyNameFix funcName)+testGroupGenerator = join $ testGroupGeneratorFor <$> fmap loc_module location <*> testFunctions+ where+  testFunctions = location >>= runIO . extractTestFunctions . loc_filename -propListGenerator :: ExpQ-propListGenerator = listGenerator "^prop_" "testProperty"+-- | Retrieves all function names from the given file that would be discovered by 'testGroupGenerator'.+extractTestFunctions :: FilePath -> IO [String]+extractTestFunctions filePath = do+  file <- readFile filePath+  let functions = map fst . concatMap lex . lines $ file+      filtered pat = filter (pat `isPrefixOf`) functions+  return . nub $ concat [filtered "prop_", filtered "case_", filtered "test_"] -caseListGenerator :: ExpQ-caseListGenerator = listGenerator "^case_" "testCase"+-- | Extract the name of the current module.+locationModule :: ExpQ+locationModule = do+  loc <- location+  return $ LitE $ StringL $ loc_module loc -testListGenerator :: ExpQ-testListGenerator = listGenerator "^test_" "testGroup"+-- | Like 'testGroupGenerator', but generates a test group only including the specified function names.+-- The function names still need to follow the pattern of starting with one of @prop_@, @case_@ or @test_@.+testGroupGeneratorFor+  :: String   -- ^ The name of the test group itself+  -> [String] -- ^ The names of the functions which should be included in the test group+  -> ExpQ+testGroupGeneratorFor name functionNames = [| testGroup name $(listE (mapMaybe test functionNames)) |]+ where+  testFunctions = [("prop_", "testProperty"), ("case_", "testCase"), ("test_", "testGroup")]+  getTestFunction fname = snd <$> find ((`isPrefixOf` fname) . fst) testFunctions+  test fname = do+    fn <- getTestFunction fname+    return $ appE (appE (varE $ mkName fn) (stringE (fixName fname))) (varE (mkName fname)) --- | 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"))))+-- | Like 'defaultMainGenerator', but only includes the specific function names in the test group.+-- The function names still need to follow the pattern of starting with one of @prop_@, @case_@ or @test_@.+defaultMainGeneratorFor+  :: String   -- ^ The name of the top-level test group+  -> [String] -- ^ The names of the functions which should be included in the test group+  -> ExpQ+defaultMainGeneratorFor name fns = [| defaultMain $(testGroupGeneratorFor name fns) |]  fixName :: String -> String-fixName name = replace '_' ' ' $ drop 5 name+fixName = replace '_' ' ' . tail . dropWhile (/= '_')  replace :: Eq a => a -> a -> [a] -> [a] replace b v = map (\i -> if b == i then v else i)

@@ -1,20 +1,20 @@ name: tasty-th-version: 0.1.3+version: 0.1.4 cabal-version: >= 1.6 build-type: Simple license: BSD3 license-file: BSD3.txt maintainer: Benno Fünfstück <benno.fuenfstueck@gmail.com> homepage: http://github.com/bennofs/tasty-th-synopsis: Automagically generate the HUnit- and Quickcheck-bulk-code using Template Haskell.-description: A fork of of test-framework-th modified to use tasty instead of test-framework.+synopsis: Automatic tasty test case discovery using TH+description: Generate tasty TestTrees automatically with TemplateHaskell. See the README for example usage.  category: Testing author: Oscar Finnsson & Emil Nordling & Benno Fünfstück  library   exposed-modules: Test.Tasty.TH-  build-depends: base >= 4 && < 5, tasty, language-haskell-extract >= 0.2, template-haskell+  build-depends: base >= 4 && < 5, tasty, template-haskell   hs-source-dirs: src   other-extensions: TemplateHaskell