tasty-th-0.1.7/0000755000000000000000000000000013072726675011501 5ustar0000000000000000tasty-th-0.1.7/BSD3.txt0000644000000000000000000000300013072726675012726 0ustar0000000000000000Copyright (c) 2010, Oscar Finnsson Copyright (c) 2013-2017, Benno Fünfstück 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. tasty-th-0.1.7/Setup.lhs0000644000000000000000000000015613072726675013313 0ustar0000000000000000#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain tasty-th-0.1.7/tasty-th.cabal0000644000000000000000000000203613072726675014243 0ustar0000000000000000name: tasty-th version: 0.1.7 cabal-version: >= 1.8 build-type: Simple license: BSD3 license-file: BSD3.txt maintainer: Benno Fünfstück homepage: http://github.com/bennofs/tasty-th 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 extra-source-files: example.hs example-explicit.hs example-literate.lhs library exposed-modules: Test.Tasty.TH build-depends: base >= 4 && < 5, haskell-src-exts >= 1.18.0, tasty, template-haskell hs-source-dirs: src ghc-options: -Wall other-extensions: TemplateHaskell test-suite tasty-th-tests hs-source-dirs: tests main-is: Main.hs build-depends: base >= 4 && < 5, tasty-hunit, tasty-th ghc-options: -Wall default-language: Haskell2010 type: exitcode-stdio-1.0 source-repository head type: git location: https://github.com/bennofs/tasty-th.git tasty-th-0.1.7/example.hs0000644000000000000000000000112413072726675013466 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Main where import Test.Tasty import Test.Tasty.TH import Test.Tasty.QuickCheck import Test.Tasty.HUnit main :: IO () main = $(defaultMainGenerator) {- Properties in comments are not run: prop_comment :: Assertion prop_comment = assertFailure "property in comment should not be run" -} prop_length_append :: [Int] -> [Int] -> Bool prop_length_append as bs = length (as ++ bs) == length as + length bs case_length_1 :: Assertion case_length_1 = 1 @=? length [()] test_plus :: [TestTree] test_plus = [ testCase "3 + 4" (7 @=? (3 + 4)) -- ... ] tasty-th-0.1.7/example-explicit.hs0000644000000000000000000000111413072726675015304 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Main where import Test.Tasty import Test.Tasty.TH import Test.Tasty.QuickCheck import Test.Tasty.HUnit main :: IO () main = $(defaultMainGeneratorFor "explicit" ["prop_length_append", "case_length_1", "test_plus"]) prop_length_append :: [Int] -> [Int] -> Bool prop_length_append as bs = length (as ++ bs) == length as + length bs case_length_1 :: Assertion case_length_1 = 1 @=? length [()] case_add :: Assertion case_add = 7 @=? (3 + 4) test_plus :: [TestTree] test_plus = [ $(testGroupGeneratorFor "case_add" ["case_add"]) -- ... ] tasty-th-0.1.7/example-literate.lhs0000644000000000000000000000160313072726675015453 0ustar0000000000000000This is an example of using tasty-th with literate haskell files. First, we need to import the library and enable template haskell: > {-# LANGUAGE TemplateHaskell #-} > import Test.Tasty > import Test.Tasty.TH > import Test.Tasty.QuickCheck > import Test.Tasty.HUnit Now, we can write some quickcheck properties: > prop_length_append :: [Int] -> [Int] -> Bool > prop_length_append as bs = length (as ++ bs) == length as + length bs Or write a HUnit test case: > case_length_1 :: Assertion > case_length_1 = 1 @=? length [()] Properties in comments are not run: prop_comment :: Assertion prop_comment = assertFailure "property in comment should not be run" We can also create test trees: > test_plus :: [TestTree] > test_plus = > [ testCase "3 + 4" (7 @=? (3 + 4)) > -- ... > ] We only need a main now that collects all our tests: > main :: IO () > main = $(defaultMainGenerator) tasty-th-0.1.7/src/0000755000000000000000000000000013072726675012270 5ustar0000000000000000tasty-th-0.1.7/src/Test/0000755000000000000000000000000013072726675013207 5ustar0000000000000000tasty-th-0.1.7/src/Test/Tasty/0000755000000000000000000000000013072726675014313 5ustar0000000000000000tasty-th-0.1.7/src/Test/Tasty/TH.hs0000644000000000000000000001342413072726675015166 0ustar0000000000000000----------------------------------------------------------------------------- -- -- Module : Test.Tasty.TH -- Copyright : Oscar Finnsson, Benno Fünfstück -- License : BSD3 -- -- Maintainer : Benno Fünfstück -- Stability : -- Portability : -- -- ----------------------------------------------------------------------------- {-# 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.Exts (parseFileContentsWithMode) import Language.Haskell.Exts.Parser (ParseResult(..), defaultParseMode, parseFilename) import qualified Language.Haskell.Exts.Syntax as S import Language.Haskell.TH import Data.Maybe import Data.Data (gmapQ, Data) import Data.Typeable (cast) import Data.List (nub, isPrefixOf, find) import qualified Data.Foldable as F import Test.Tasty import Prelude -- | 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'. -- -- Example usage: -- -- @ -- -- properties, test cases, .... -- -- main :: IO () -- main = $('defaultMainGenerator') -- @ defaultMainGenerator :: ExpQ defaultMainGenerator = [| defaultMain $(testGroupGenerator) |] -- | This function generates a 'TestTree' from functions in the current module. -- The test tree is named after the current module. -- -- The following definitions are collected by `testGroupGenerator`: -- -- * 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" -- -- Example usage: -- -- @ -- prop_example :: Int -> Int -> Bool -- prop_example a b = a + b == b + a -- -- tests :: 'TestTree' -- tests = $('testGroupGenerator') -- @ testGroupGenerator :: ExpQ testGroupGenerator = join $ testGroupGeneratorFor <$> fmap loc_module location <*> testFunctions where testFunctions = location >>= runIO . extractTestFunctions . loc_filename -- | Retrieves all function names from the given file that would be discovered by 'testGroupGenerator'. extractTestFunctions :: FilePath -> IO [String] extractTestFunctions filePath = do file <- readFile filePath -- we first try to parse the file using haskell-src-exts -- if that fails, we fallback to lexing each line, which is less -- accurate but is more reliable (haskell-src-exts sometimes struggles -- with less-common GHC extensions). let functions = fromMaybe (lexed file) (parsed file) filtered pat = filter (pat `isPrefixOf`) functions return . nub $ concat [filtered "prop_", filtered "case_", filtered "test_"] where lexed = map fst . concatMap lex . lines parsed file = case parseFileContentsWithMode (defaultParseMode { parseFilename = filePath }) file of ParseOk parsedModule -> Just (declarations parsedModule) ParseFailed _ _ -> Nothing declarations (S.Module _ _ _ _ decls) = concatMap testFunName decls declarations _ = [] testFunName (S.PatBind _ pat _ _) = patternVariables pat testFunName (S.FunBind _ clauses) = nub (map clauseName clauses) testFunName _ = [] clauseName (S.Match _ name _ _ _) = nameString name clauseName (S.InfixMatch _ _ name _ _ _) = nameString name -- | Convert a 'Name' to a 'String' nameString :: S.Name l -> String nameString (S.Ident _ n) = n nameString (S.Symbol _ n) = n -- | Find all variables that are bound in the given pattern. patternVariables :: Data l => S.Pat l -> [String] patternVariables = go where go (S.PVar _ name) = [nameString name] go pat = concat $ gmapQ (F.foldMap go . cast) pat -- | Extract the name of the current module. locationModule :: ExpQ locationModule = do loc <- location return $ LitE $ StringL $ loc_module loc -- | 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)) -- | 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 = replace '_' ' ' . tail . dropWhile (/= '_') replace :: Eq a => a -> a -> [a] -> [a] replace b v = map (\i -> if b == i then v else i) tasty-th-0.1.7/tests/0000755000000000000000000000000013072726675012643 5ustar0000000000000000tasty-th-0.1.7/tests/Main.hs0000644000000000000000000000161413072726675014065 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} import Test.Tasty.TH import Test.Tasty.HUnit import Data.List (sort) main :: IO () main = $(defaultMainGenerator) case_example_test_functions :: Assertion case_example_test_functions = do functions <- extractTestFunctions "example.hs" let expected = [ "prop_length_append", "case_length_1", "test_plus" ] sort expected @=? sort functions case_example_explicit_test_functions :: Assertion case_example_explicit_test_functions = do functions <- extractTestFunctions "example-explicit.hs" let expected = [ "case_add", "prop_length_append", "case_length_1", "test_plus" ] sort expected @=? sort functions case_example_literate_test_functions :: Assertion case_example_literate_test_functions = do functions <- extractTestFunctions "example-literate.lhs" let expected = [ "prop_length_append", "case_length_1", "test_plus" ] sort expected @=? sort functions