tasty-discover-4.2.1/executable/0000755000000000000000000000000013305616337015014 5ustar0000000000000000tasty-discover-4.2.1/library/0000755000000000000000000000000013305616337014337 5ustar0000000000000000tasty-discover-4.2.1/library/Test/0000755000000000000000000000000013305616337015256 5ustar0000000000000000tasty-discover-4.2.1/library/Test/Tasty/0000755000000000000000000000000013305616337016362 5ustar0000000000000000tasty-discover-4.2.1/test/0000755000000000000000000000000013305616337013652 5ustar0000000000000000tasty-discover-4.2.1/test/SubMod/0000755000000000000000000000000013305616337015043 5ustar0000000000000000tasty-discover-4.2.1/test/SubMod/SubSubMod/0000755000000000000000000000000013305616337016706 5ustar0000000000000000tasty-discover-4.2.1/library/Test/Tasty/Config.hs0000644000000000000000000001132513305616337020125 0ustar0000000000000000-- | The test driver configuration options module. -- -- Anything that can be passed as an argument to the test driver -- definition exists as a field in the 'Config' type. module Test.Tasty.Config ( -- * Configuration Options Config (..) , GlobPattern -- * Configuration Parser , parseConfig -- * Configuration Defaults , defaultConfig ) where import Data.Maybe (isJust) import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), ArgOrder (Permute), OptDescr (Option), getOpt') -- | A tasty ingredient. type Ingredient = String -- | A glob pattern. type GlobPattern = String -- | The discovery and runner configuration. data Config = Config { modules :: Maybe GlobPattern -- ^ Glob pattern for matching modules during test discovery. , moduleSuffix :: Maybe String -- ^ <<>>: Module suffix. , generatedModuleName :: Maybe String -- ^ Name of the generated main module. , ignores :: Maybe GlobPattern -- ^ Glob pattern for ignoring modules during test discovery. , ignoredModules :: [FilePath] -- ^ <<>>: Ignored modules by full name. , tastyIngredients :: [Ingredient] -- ^ Tasty ingredients to use. , tastyOptions :: [String] -- ^ Options passed to tasty , noModuleSuffix :: Bool -- ^ <<>>: suffix and look in all modules. , debug :: Bool -- ^ Debug the generated module. , treeDisplay :: Bool -- ^ Tree display for the test results table. } deriving (Show) -- | The default configuration defaultConfig :: Config defaultConfig = Config Nothing Nothing Nothing Nothing [] [] [] False False False -- | Deprecation message for old `--[no-]module-suffix` option. moduleSuffixDeprecationMessage :: String moduleSuffixDeprecationMessage = error $ concat [ "\n\n" , "----------------------------------------------------------\n" , "DEPRECATION NOTICE: `--[no-]module-suffix` is deprecated.\n" , "The default behaviour now discovers all test module suffixes.\n" , "Please use the `--modules=''` option to specify.\n" , "----------------------------------------------------------\n" ] -- | Deprecation message for old `--ignore-module` option. ignoreModuleDeprecationMessage :: String ignoreModuleDeprecationMessage = error $ concat [ "\n\n" , "----------------------------------------------------------\n" , "DEPRECATION NOTICE: `--ignore-module` is deprecated.\n" , "Please use the `--ignores=''` option instead.\n" , "----------------------------------------------------------\n" ] -- | Configuration options parser. parseConfig :: String -> [String] -> Either String Config parseConfig prog args = case getOpt' Permute options args of (opts, rest, rest', []) -> let config = foldl (flip id) defaultConfig { tastyOptions = rest ++ rest' } opts in if noModuleSuffix config || isJust (moduleSuffix config) then error moduleSuffixDeprecationMessage else if not $ null (ignoredModules config) then error ignoreModuleDeprecationMessage else Right config (_, _, _, err:_) -> formatError err where formatError err = Left (prog ++ ": " ++ err) -- | All configuration options. options :: [OptDescr (Config -> Config)] options = [ Option [] ["modules"] (ReqArg (\s c -> c {modules = Just s}) "GLOB-PATTERN") "Specify desired modules with a glob pattern (white-list)" , Option [] ["module-suffix"] (ReqArg (\s c -> c {moduleSuffix = Just s}) "SUFFIX") "<<>>: Specify desired test module suffix" , Option [] ["generated-module"] (ReqArg (\s c -> c {generatedModuleName = Just s}) "MODULE") "Qualified generated module name" , Option [] ["ignores"] (ReqArg (\s c -> c {ignores = Just s}) "GLOB-PATTERN") "Specify desired modules to ignore with a glob pattern (black-list)" , Option [] ["ignore-module"] (ReqArg (\s c -> c {ignoredModules = s : ignoredModules c}) "FILE") "<<>>: Ignore a test module" , Option [] ["ingredient"] (ReqArg (\s c -> c {tastyIngredients = s : tastyIngredients c}) "INGREDIENT") "Qualified tasty ingredient name" , Option [] ["no-module-suffix"] (NoArg $ \c -> c {noModuleSuffix = True}) "<<>>: Ignore test module suffix and import them all" , Option [] ["debug"] (NoArg $ \c -> c {debug = True}) "Debug output of generated test module" , Option [] ["tree-display"] (NoArg $ \c -> c {treeDisplay = True}) "Display test output hierarchically" ] tasty-discover-4.2.1/library/Test/Tasty/Discover.hs0000644000000000000000000001436213305616337020502 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Automatic test discovery and runner for the tasty framework. module Test.Tasty.Discover ( -- * Main Test Generator generateTestDriver -- * For Testing Purposes Only , ModuleTree (..) , findTests , mkModuleTree , showTests ) where import Data.List (dropWhileEnd, intercalate, isPrefixOf, nub, stripPrefix) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) #if defined(mingw32_HOST_OS) import GHC.IO.Encoding.CodePage (mkLocaleEncoding) import GHC.IO.Encoding.Failure (CodingFailureMode (TransliterateCodingFailure)) import GHC.IO.Handle (hGetContents, hSetEncoding) #else import GHC.IO.Handle (hGetContents) #endif import System.FilePath (pathSeparator, takeDirectory) import System.FilePath.Glob (compile, globDir1, match) import System.IO (IOMode (ReadMode), openFile) import Test.Tasty.Config (Config (..), GlobPattern) import Test.Tasty.Generator (Generator (..), Test (..), generators, getGenerators, mkTest, showSetup) -- | Main function generator, along with all the boilerplate which -- which will run the discovered tests. generateTestDriver :: Config -> String -> [String] -> FilePath -> [Test] -> String generateTestDriver config modname is src tests = let generators' = getGenerators tests testNumVars = map (("t"++) . show) [(0 :: Int)..] in concat [ "{-# LINE 1 " ++ show src ++ " #-}\n" , "{-# LANGUAGE FlexibleInstances #-}\n" , "module " ++ modname ++ " (main, ingredients, tests) where\n" , "import Prelude\n" , "import qualified System.Environment as E\n" , "import qualified Test.Tasty as T\n" , "import qualified Test.Tasty.Ingredients as T\n" , unlines $ map generatorImport generators' , showImports (map ingredientImport is ++ map testModule tests) , unlines $ map generatorClass generators' , "tests :: IO T.TestTree\n" , "tests = do\n" , unlines $ zipWith showSetup tests testNumVars , " pure $ T.testGroup " ++ show src ++ " [" , intercalate "," $ showTests config tests testNumVars , "]\n" , "ingredients :: [T.Ingredient]\n" , "ingredients = " ++ ingredients is ++ "\n" , "main :: IO ()\n" , "main = do\n" , " args <- E.getArgs\n" , " E.withArgs (" ++ show (tastyOptions config) ++ " ++ args) $" , " tests >>= T.defaultMainWithIngredients ingredients\n" ] -- | Match files by specified glob pattern. filesByModuleGlob :: FilePath -> Maybe GlobPattern -> IO [String] filesByModuleGlob directory globPattern = do globDir1 pattern directory where pattern = compile ("**/" ++ fromMaybe "*.hs*" globPattern) -- | Filter and remove files by specified glob pattern. ignoreByModuleGlob :: [FilePath] -> Maybe GlobPattern -> [FilePath] ignoreByModuleGlob filePaths Nothing = filePaths ignoreByModuleGlob filePaths (Just ignoreGlob) = filter (not . match pattern) filePaths where pattern = compile ("**/" ++ ignoreGlob) -- | Discover the tests modules. findTests :: FilePath -> Config -> IO [Test] findTests src config = do let directory = takeDirectory src allModules <- filesByModuleGlob directory (modules config) let filtered = ignoreByModuleGlob allModules (ignores config) concat <$> traverse (extract directory) filtered where extract directory filePath = do h <- openFile filePath ReadMode #if defined(mingw32_HOST_OS) -- Avoid internal error: hGetContents: invalid argument (invalid byte sequence)' non UTF-8 Windows hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure #endif extractTests (dropDirectory directory filePath) <$> hGetContents h dropDirectory directory filePath = fromMaybe filePath $ stripPrefix (directory ++ [pathSeparator]) filePath -- | Extract the test names from discovered modules. extractTests :: FilePath -> String -> [Test] extractTests file = mkTestDeDuped . isKnownPrefix . parseTest where mkTestDeDuped = map (mkTest file) . nub isKnownPrefix = filter (\g -> any (checkPrefix g) generators) checkPrefix g = (`isPrefixOf` g) . generatorPrefix parseTest = map fst . concatMap lex . lines -- | Show the imports. showImports :: [String] -> String showImports mods = unlines $ nub $ map (\m -> "import qualified " ++ m ++ "\n") mods -- | Retrieve the ingredient name. ingredientImport :: String -> String ingredientImport = init . dropWhileEnd (/= '.') -- | Ingredients to be included. ingredients :: [String] -> String ingredients is = concat $ map (++":") is ++ ["T.defaultIngredients"] -- | Show the tests. showTests :: Config -> [Test] -> [String] -> [String] showTests config tests testNumVars = if treeDisplay config then showModuleTree $ mkModuleTree tests testNumVars else zipWith (curry snd) tests testNumVars newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String])) deriving (Eq, Show) showModuleTree :: ModuleTree -> [String] showModuleTree (ModuleTree mdls) = map showModule $ M.assocs mdls where -- special case, collapse to mdl.submdl showModule (mdl, (ModuleTree subMdls, [])) | M.size subMdls == 1 = let [(subMdl, (subSubTree, testVars))] = M.assocs subMdls in showModule (mdl ++ '.' : subMdl, (subSubTree, testVars)) showModule (mdl, (subTree, testVars)) = concat [ "T.testGroup \"", mdl , "\" [", intercalate "," (showModuleTree subTree ++ testVars), "]" ] mkModuleTree :: [Test] -> [String] -> ModuleTree mkModuleTree tests testVars = ModuleTree $ foldr go M.empty $ zipWith (\t tVar -> (testModule t, tVar)) tests testVars where go (mdl, tVar) mdls = M.insertWith merge key val mdls where (key, val) = case break (== '.') mdl of (_, []) -> (mdl, (ModuleTree M.empty, [tVar])) (topMdl, '.':subMdl) -> (topMdl, (ModuleTree $ go (subMdl, tVar) M.empty, [])) _ -> error "impossible case in mkModuleTree.go.key" merge (ModuleTree mdls1, tVars1) (ModuleTree mdls2, tVars2) = (ModuleTree $ M.unionWith merge mdls1 mdls2, tVars1 ++ tVars2) tasty-discover-4.2.1/library/Test/Tasty/Generator.hs0000644000000000000000000001221713305616337020647 0ustar0000000000000000-- | The test generator boilerplate module. -- -- Any test that is supported (HUnit, HSpec, etc.) provides here, a -- generator type with all the context necessary for outputting the -- necessary boilerplate for the generated main function that will -- run all the tests. module Test.Tasty.Generator ( -- * Types Generator (..) , Test (..) -- * Generators , generators , getGenerator , getGenerators -- * Boilerplate Formatter , showSetup -- * Type Constructor , mkTest ) where import Data.Function (on) import Data.List (find, groupBy, isPrefixOf, sortOn) import Data.Maybe (fromJust) import System.FilePath (dropExtension, isPathSeparator) -- | The test type. data Test = Test { testModule :: String -- ^ Module name. , testFunction :: String -- ^ Function name. } deriving (Eq, Show, Ord) -- | 'Test' constructor. mkTest :: FilePath -> String -> Test mkTest = Test . replacePathSepTo '.' . dropExtension where replacePathSepTo c1 = map $ \c2 -> if isPathSeparator c2 then c1 else c2 -- | The generator type. data Generator = Generator { generatorPrefix :: String -- ^ Generator prefix. , generatorImport :: String -- ^ Module import path. , generatorClass :: String -- ^ Generator class. , generatorSetup :: Test -> String -- ^ Generator setup. } -- | Module import qualifier. qualifyFunction :: Test -> String qualifyFunction t = testModule t ++ "." ++ testFunction t -- | Function namer. name :: Test -> String name = chooser '_' ' ' . tail . dropWhile (/= '_') . testFunction where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3 -- | Generator retriever (single). getGenerator :: Test -> Generator getGenerator t = fromJust $ getPrefix generators where getPrefix = find ((`isPrefixOf` testFunction t) . generatorPrefix) -- | Generator retriever (many). getGenerators :: [Test] -> [Generator] getGenerators = map head . groupBy ((==) `on` generatorPrefix) . sortOn generatorPrefix . map getGenerator -- | Boilerplate formatter. showSetup :: Test -> String -> String showSetup t var = " " ++ var ++ " <- " ++ setup ++ "\n" where setup = generatorSetup (getGenerator t) t -- | All types of tests supported for boilerplate generation. generators :: [Generator] generators = [ quickCheckPropertyGenerator , smallCheckPropertyGenerator , hedgehogPropertyGenerator , hunitTestCaseGenerator , hspecTestCaseGenerator , tastyTestGroupGenerator ] -- | Quickcheck group generator prefix. hedgehogPropertyGenerator :: Generator hedgehogPropertyGenerator = Generator { generatorPrefix = "hprop_" , generatorImport = "import qualified Test.Tasty.Hedgehog as H\n" , generatorClass = "" , generatorSetup = \t -> "pure $ H.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Quickcheck group generator prefix. quickCheckPropertyGenerator :: Generator quickCheckPropertyGenerator = Generator { generatorPrefix = "prop_" , generatorImport = "import qualified Test.Tasty.QuickCheck as QC\n" , generatorClass = "" , generatorSetup = \t -> "pure $ QC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Smallcheck group generator prefix. smallCheckPropertyGenerator :: Generator smallCheckPropertyGenerator = Generator { generatorPrefix = "scprop_" , generatorImport = "import qualified Test.Tasty.SmallCheck as SC\n" , generatorClass = "" , generatorSetup = \t -> "pure $ SC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | HUnit generator prefix. hunitTestCaseGenerator :: Generator hunitTestCaseGenerator = Generator { generatorPrefix = "unit_" , generatorImport = "import qualified Test.Tasty.HUnit as HU\n" , generatorClass = concat [ "class TestCase a where testCase :: String -> a -> IO T.TestTree\n" , "instance TestCase (IO ()) where testCase n = pure . HU.testCase n\n" , "instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n\n" , "instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n\n" ] , generatorSetup = \t -> "testCase \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Hspec generator prefix. hspecTestCaseGenerator :: Generator hspecTestCaseGenerator = Generator { generatorPrefix = "spec_" , generatorImport = "import qualified Test.Tasty.Hspec as HS\n" , generatorClass = "" , generatorSetup = \t -> "HS.testSpec \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Tasty group generator prefix. tastyTestGroupGenerator :: Generator tastyTestGroupGenerator = Generator { generatorPrefix = "test_" , generatorImport = "" , generatorClass = concat [ "class TestGroup a where testGroup :: String -> a -> IO T.TestTree\n" , "instance TestGroup T.TestTree where testGroup _ a = pure a\n" , "instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a\n" , "instance TestGroup (IO T.TestTree) where testGroup _ a = a\n" , "instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a\n" ] , generatorSetup = \t -> "testGroup \"" ++ name t ++ "\" " ++ qualifyFunction t } tasty-discover-4.2.1/executable/Main.hs0000644000000000000000000000217513305616337016241 0ustar0000000000000000-- | Main executable module. module Main where import Control.Monad (when) import Data.Maybe (fromMaybe) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) import Test.Tasty.Config (Config (..), parseConfig) import Test.Tasty.Discover (findTests, generateTestDriver) -- | Main function. main :: IO () main = do args <- getArgs name <- getProgName case args of src : _ : dst : opts -> case parseConfig name opts of Left err -> do hPutStrLn stderr err exitFailure Right config -> do tests <- findTests src config let ingredients = tastyIngredients config moduleName = fromMaybe "Main" (generatedModuleName config) output = generateTestDriver config moduleName ingredients src tests when (debug config) $ hPutStrLn stderr output writeFile dst output _ -> do hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" exitFailure tasty-discover-4.2.1/test/Driver.hs0000644000000000000000000000005413305616337015440 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF tasty-discover #-} tasty-discover-4.2.1/test/ConfigTest.hs0000644000000000000000000000642513305616337016262 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module ConfigTest where import Data.List (isInfixOf, sort) import qualified Data.Map.Strict as M import Test.Tasty.Config import Test.Tasty.Discover (ModuleTree (..), findTests, generateTestDriver, mkModuleTree, showTests) import Test.Tasty.Generator (Test (..), mkTest) import Test.Tasty.Hspec import Test.Tasty.HUnit import Test.Tasty.QuickCheck spec_modules :: Spec spec_modules = describe "Test discovery" $ it "Discovers tests" $ do let expectedTests = [ mkTest "PropTest.hs" "prop_additionAssociative", mkTest "SubSubMod/PropTest.hs" "prop_additionCommutative" ] config = defaultConfig { modules = Just "*Test.hs" } discoveredTests <- findTests "test/SubMod/" config sort discoveredTests `shouldBe` sort expectedTests spec_ignores :: Spec spec_ignores = describe "Module ignore configuration" $ it "Ignores tests in modules with the specified suffix" $ do let ignoreModuleConfig = defaultConfig { ignores = Just "*.hs" } discoveredTests <- findTests "test/SubMod/" ignoreModuleConfig discoveredTests `shouldBe` [] spec_badModuleGlob :: Spec spec_badModuleGlob = describe "Module suffix configuration" $ it "Filters discovered tests by specified suffix" $ do let badGlobConfig = defaultConfig { modules = Just "DoesntExist*.hs" } discoveredTests <- findTests "test/SubMod/" badGlobConfig discoveredTests `shouldBe` [] spec_customModuleName :: Spec spec_customModuleName = describe "Module name configuration" $ it "Creates a generated main function with the specified name" $ do let generatedModule = generateTestDriver defaultConfig "FunkyModuleName" [] "test/" [] "FunkyModuleName" `shouldSatisfy` (`isInfixOf` generatedModule) unit_noTreeDisplayDefault :: IO () unit_noTreeDisplayDefault = do tests <- findTests "test/SubMod/" defaultConfig let testNumVars = map (('t' :) . show) [(0::Int)..] trees = showTests defaultConfig tests testNumVars length trees @?= 4 unit_treeDisplay :: IO () unit_treeDisplay = do let config = defaultConfig { treeDisplay = True } tests <- findTests "test/SubMod/" config let testNumVars = map (('t' :) . show) [(0::Int)..] trees = showTests config tests testNumVars length trees @?= 3 prop_mkModuleTree :: ModuleTree -> Property prop_mkModuleTree mtree = let (tests, testVars) = unzip $ flattenTree mtree in mkModuleTree tests testVars === mtree where flattenTree (ModuleTree mp) = M.assocs mp >>= flattenModule flattenModule (mdl, (subTree, testVars)) = concat [ map (\(Test subMdl _, tVar) -> (Test (mdl ++ '.':subMdl) "-", tVar)) (flattenTree subTree) , map (\tVar -> (Test mdl "-", tVar)) testVars ] instance Arbitrary ModuleTree where arbitrary = sized $ \size -> resize (min size 12) (ModuleTree . M.fromList <$> listOf1 mdlGen) where mdlGen = sized $ \size -> do mdl <- listOf1 (elements ['a'..'z']) subTree <- if size == 0 then pure $ ModuleTree M.empty else resize (size `div` 2) arbitrary tVars <- listOf1 (listOf1 arbitrary) pure (mdl, (subTree, tVars)) tasty-discover-4.2.1/test/DiscoverTest.hs0000644000000000000000000000304513305616337016626 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module DiscoverTest where import Data.List import qualified Hedgehog as H import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty import Test.Tasty.Hspec import Test.Tasty.HUnit import Test.Tasty.QuickCheck unit_listCompare :: IO () unit_listCompare = [1 :: Int, 2, 3] `compare` [1,2] @?= GT prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a scprop_sortReverse :: [Int] -> Bool scprop_sortReverse list = sort list == sort (reverse list) spec_prelude :: Spec spec_prelude = describe "Prelude.head" $ it "returns the first element of a list" $ head [23 ..] `shouldBe` (23 :: Int) test_addition :: TestTree test_addition = testProperty "Addition commutes" $ \(a :: Int) (b :: Int) -> a + b == b + a test_multiplication :: [TestTree] test_multiplication = [ testProperty "Multiplication commutes" $ \(a :: Int) (b :: Int) -> a * b == b * a , testProperty "One is identity" $ \(a :: Int) -> a == a ] test_generateTree :: IO TestTree test_generateTree = do let input = "Some input" pure $ testCase input $ pure () test_generateTrees :: IO [TestTree] test_generateTrees = map (\ s -> testCase s $ pure ()) <$> pure ["First input", "Second input"] {-# ANN hprop_reverse "HLint: ignore Avoid reverse" #-} hprop_reverse :: H.Property hprop_reverse = H.property $ do xs <- H.forAll $ Gen.list (Range.linear 0 100) Gen.alpha reverse (reverse xs) H.=== xs tasty-discover-4.2.1/test/SubMod/FooBaz.hs0000644000000000000000000000043413305616337016560 0ustar0000000000000000module SubMod.FooBaz where prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a prop_multiplationDistributiveOverAddition :: Integer -> Integer -> Integer -> Bool prop_multiplationDistributiveOverAddition a b c = a * (b + c) == a * b + a * c tasty-discover-4.2.1/test/SubMod/PropTest.hs0000644000000000000000000000022013305616337017151 0ustar0000000000000000module SubMod.PropTest where prop_additionAssociative :: Int -> Int -> Int -> Bool prop_additionAssociative a b c = (a + b) + c == a + (b + c) tasty-discover-4.2.1/test/SubMod/SubSubMod/PropTest.hs0000644000000000000000000000020513305616337021017 0ustar0000000000000000module SubMod.SubSubMod.PropTest where prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a tasty-discover-4.2.1/LICENSE0000644000000000000000000000203713305616337013702 0ustar0000000000000000Copyright (c) 2016 Luke Murphy Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tasty-discover-4.2.1/Setup.hs0000644000000000000000000000005613305616337014330 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-discover-4.2.1/tasty-discover.cabal0000644000000000000000000000504613305617002016632 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- -- hash: c69bb3382cc20b5891546bfbf1fc899a6933c635332b6a4d5bde683aee75193a name: tasty-discover version: 4.2.1 synopsis: Test discovery for the tasty framework. description: Automatic test discovery and runner for the tasty framework. Prefix your test case names and tasty-discover will discover, collect and run them. All popular test libraries are covered. Configure once and then just write your tests. Avoid forgetting to add test modules to your Cabal/Hpack files. Tasty ingredients are included along with various configuration options for different use cases. Please see the `README.md` below for how to get started. category: Testing stability: Experimental homepage: http://git.coop/lwm/tasty-discover bug-reports: http://git.coop/lwm/tasty-discover/issues author: Luke Murphy maintainer: Luke Murphy copyright: 2016 Luke Murphy license: MIT license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: http://git.coop/lwm/tasty-discover library hs-source-dirs: library ghc-options: -Wall build-depends: Glob >=0.8 && <1.0 , base >=4.8 && <5.0 , containers >=0.4 && <1.0 , directory >=1.1 && <2.0 , filepath >=1.3 && <2.0 exposed-modules: Test.Tasty.Config Test.Tasty.Discover Test.Tasty.Generator other-modules: Paths_tasty_discover default-language: Haskell2010 executable tasty-discover main-is: executable/Main.hs ghc-options: -Wall build-depends: Glob >=0.8 && <1.0 , base >=4.8 && <5.0 , containers >=0.4 && <1.0 , directory >=1.1 && <2.0 , filepath >=1.3 && <2.0 , tasty-discover other-modules: Paths_tasty_discover default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: Driver.hs hs-source-dirs: test ghc-options: -Wall build-depends: Glob >=0.8 && <1.0 , base , containers >=0.4 && <1.0 , directory >=1.1 && <2.0 , filepath >=1.3 && <2.0 , hedgehog , tasty , tasty-discover , tasty-hedgehog , tasty-hspec , tasty-hunit , tasty-quickcheck , tasty-smallcheck other-modules: ConfigTest DiscoverTest SubMod.FooBaz SubMod.PropTest SubMod.SubSubMod.PropTest Paths_tasty_discover default-language: Haskell2010 tasty-discover-4.2.1/CHANGELOG.md0000644000000000000000000001126313305616655014512 0ustar0000000000000000# Change Log All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog] and this project adheres to [Semantic Versioning]. [Keep a Changelog]: http://keepachangelog.com/ [Semantic Versioning]: http://semver.org/ # 4.2.1 [2018-06-06] ## Changed - Migrated source code hosting to https://git.coop/lwm/tasty-discover. # 4.2.0 [2018-03-03] ## Fixed - Actually support `scprop_` prefixed SmallCheck test cases (see issue [#140]). [#140]: https://github.com/lwm/tasty-discover/issues/140 # 4.1.5 [2018-02-26] ## Fixed - Fixed multi-byte string issue (see pull request [#138]). [#138]: https://github.com/lwm/tasty-discover/pull/138 # 4.1.4 [2018-02-25] ## Added - Windows OS continuous integration build (see pull request [#136]). ## Fixed - Test failure related to path handling on Windows OS (see pull request [#136]). - Resolved upstream tasty-hedgehog nightly blocking issue (see issue [#131]). [#136]: https://github.com/lwm/tasty-discover/pull/136 [#131]: https://github.com/lwm/tasty-discover/issues/131 # 4.1.3 [2018-01-01] ## Fixed - Re-enable on Stackage due to tasty/tasty-hedgehog failure (see issue [#132]). [#132]: https://github.com/lwm/tasty-discover/pull/132 # 4.1.2 [2017-12-19] ## Fixed - Escaping issues for the Windows platform (see issue [#124]). [#124]: https://github.com/lwm/tasty-discover/issues/124 # 4.1.1 [2017-09-26] ## Fixed - Incorrect test case doing bad comparison (see issue [#123]). [#123]: https://github.com/lwm/tasty-discover/issues/123 # 4.1.0 [2017-09-26] ## Fixed - Find tests recursively in test directory. (see pull request [#122]). ## Added - Add ability to override tasty arguments (see pull request [#120]). [#120]: https://github.com/lwm/tasty-discover/pull/120 [#122]: https://github.com/lwm/tasty-discover/pull/122 # 4.0.0 [2017-09-01] ## Changed - Deprecated `--[no-]module-suffix` for `--modules` (see pull request [#117]). - Deprecated `--ignore-module` for `--ignores` (see pull request [#117]). ## Added - `tasty-hedgehog` is now a supported test library. ## Removed - `case_` prefixes have been removed. [#117]: https://github.com/lwm/tasty-discover/pull/117 # 3.0.2 [2017-06-05] ### Fixed - Make upper bounds for dependencies looser. - Fix typo in README.md option documentation. ### Remove - Remove TOC, the hyperlinks weren't working on Hackage. # 3.0.1 [2017-06-04] ### Fixed - Fixed CHANGELOG.md rendering for Hackage (see pull request [#106]). ### Added - Add missing --tree-display documentation note (see pull request [#107]). [#107]: https://github.com/lwm/tasty-discover/pull/107 [#106]: https://github.com/lwm/tasty-discover/pull/106 # 3.0.0 [2017-06-03] ### Added - Add --tree-display configuration option (see pull request [#103]). ### Changed - Deprecate `case_` in favour of `unit_` for HUnit test cases (see pull request [#97]). ### Fixed - Correctly handle sub-directories when using --no-module-suffix (see pull request [#102]). [#97]: https://github.com/lwm/tasty-discover/pull/97 [#102]: https://github.com/lwm/tasty-discover/pull/102 [#103]: https://github.com/lwm/tasty-discover/pull/103 # 2.0.3 [2017-04-13] ### Fixed - Make the Cabal description more clear for Hackage. # 2.0.2 [2017-04-13] ### Added - README.md and CHANGELOG.md included for Hackage (see pull request [#96]). - Re-add stylish-haskell automated checking (see pull request [#88]). [#88]: https://github.com/lwm/tasty-discover/pull/88 [#96]: https://github.com/lwm/tasty-discover/pull/96 ## 2.0.1 [2017-03-18] ### Fixed - Fix flaky test comparison (see pull request [#86]). [#86]: https://github.com/lwm/tasty-discover/pull/86 ### Removed - Remove the Test.Tasty.Type module (see pull request [#83]). [#83]: https://github.com/lwm/tasty-discover/pull/83 ## 2.0.0 [2017-03-15] ### Added - Add new hpack format. - Add generator style test discovery from tasty-auto. - Add new configuration options: debug, ingredients and module name. - Add unit tests for all functionality. ### Fixed - Re-license to MIT. ### Removed - RTD documentation. - TemplateHaskell dependency - Example project and integration test project. ### Changed - Move all tests into test folder. ## 1.1.0 [2017-01-19] ### Added - Add --ignore-module configuration option. ## 1.0.1 [2017-11-13] ### Added - Add Cabal and Documentation testing on Travis CI. ### Fixed - Include missing extra-source-files. - Slim down LICENSE.md and mark as GPL-3 in Cabal file. ## 1.0.0 [2016-11-04] ### Added - Add documentation on RTD. - Release on Hackage and Stackage. ## 0.0.3 [2016-09-20] ### Added - --no-module-suffix configuration option. ## 0.0.2 [2016-02-20] ### Added - --module-suffix configuration option. ## 0.0.1 [2016-02-13] - tasty-discover initial release. tasty-discover-4.2.1/README.md0000644000000000000000000001715213305616337014160 0ustar0000000000000000[![Build Status](https://travis-ci.org/lwm/tasty-discover.svg?branch=master)](https://travis-ci.org/lwm/tasty-discover) [![tasty-discover-nightly](http://stackage.org/package/tasty-discover/badge/nightly)](http://stackage.org/nightly/package/tasty-discover) [![tasty-discover-lts](http://stackage.org/package/tasty-discover/badge/lts)](http://stackage.org/lts/package/tasty-discover) [![Hackage Status](https://img.shields.io/hackage/v/tasty-discover.svg)](http://hackage.haskell.org/package/tasty-discover) [![GitHub license](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https://raw.githubusercontent.com/lwm/tasty-discover/master/LICENSE) # tasty-discover - [Getting Started](#getting-started) * [Create Test Driver File](#create-test-driver-file) * [Configure Cabal or Hpack Test Suite](#configure-cabal-or-hpack-test-suite) - [Write Tests](#write-tests) - [Customise Discovery](#customise-discovery) * [No Arguments](#no-arguments) * [With Arguments](#with-arguments) - [Example Project](#example-project) - [Change Log](#change-log) - [Deprecation Policy](#deprecation-policy) - [Contributing](#contributing) - [Maintenance](#maintenance) - [Acknowledgements](#acknowledgements) Haskell auto-magic test discovery and runner for the [tasty test framework]. [tasty test framework]: https://github.com/feuerbach/tasty Prefix your test case names and `tasty-discover` will discover, collect and run them. All popular Haskell test libraries are covered. Configure once then just write your tests. Avoid forgetting to add test modules to your Cabal/Hpack files. Tasty ingredients are included along with various configuration options for different use cases. See below for full documentation and examples. # Getting Started There are 4 simple steps: 1. [Create a test driver file in the test directory](#create-test-driver-file) 2. [Mark the driver file as the `main-is` in the test suite](#configure-cabal-or-hpack-test-suite) 3. [Mark tests with the correct prefixes](#write-tests) 4. [Customise test discovery as needed](#customise-discovery) Check out the [example project](#example-project) to get moving quickly. ## Create Test Driver File You can name this file anything you want but it must contain the correct preprocessor definition for `tasty-discover` to run and to detect the configuration. It should be at the top level of the test directory. For example (in `test/Driver.hs`): ``` {-# OPTIONS_GHC -F -pgmF tasty-discover #-} ``` ## Configure Cabal or Hpack Test Suite In order for Cabal/Stack to know where the tests are, you'll need to configure the `main-is` option of your test-suite to point to the driver file. In the following example, the test driver file is called `Driver.hs`: ``` test-suite test main-is: Driver.hs hs-source-dirs: test build-depends: base ``` If you use [hpack], that might look like: [hpack]: https://github.com/sol/hpack ``` yaml tests: test: main: "Driver.hs" source-dirs: "test" dependencies: - "base" ``` # Write Tests Create test modules and prefix the test function name with an identifier that corresponds to the testing library you wish to run the test with: - **prop_**: [QuickCheck](http://hackage.haskell.org/package/tasty-quickcheck) properties. - **scprop_**: [SmallCheck](http://hackage.haskell.org/package/tasty-smallcheck) properties. - **hprop_**: [Hedgehog](http://hackage.haskell.org/package/tasty-hedgehog) properties. - **unit_**: [HUnit](http://hackage.haskell.org/package/tasty-hunit) test cases. - **spec_**: [Hspec](http://hackage.haskell.org/package/tasty-hspec) specifications. - **test_**: [Tasty](http://hackage.haskell.org/package/tasty) TestTrees. Here is an example test module with a bunch of different tests: ``` haskell {-# LANGUAGE ScopedTypeVariables #-} module ExampleTest where import Data.List import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Hspec import Test.Tasty.QuickCheck -- HUnit test case unit_listCompare :: IO () unit_listCompare = [1, 2, 3] `compare` [1,2] @?= GT -- QuickCheck property prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a -- SmallSheck property scprop_sortReverse :: [Int] -> Bool scprop_sortReverse list = sort list == sort (reverse list) -- Hspec specification spec_prelude :: Spec spec_prelude = do describe "Prelude.head" $ do it "returns the first element of a list" $ do head [23 ..] `shouldBe` (23 :: Int) -- Tasty TestTree test_multiplication :: [TestTree] test_multiplication = [testProperty "One is identity" $ \(a :: Int) -> a * 1 == a] -- Tasty IO TestTree test_generateTree :: IO TestTree test_generateTree = do input <- pure "Some input" pure $ testCase input $ pure () -- Tasty IO [TestTree] test_generateTrees :: IO [TestTree] test_generateTrees = do inputs <- pure ["First input", "Second input"] pure $ map (\s -> testCase s $ pure ()) inputs ``` # Customise Discovery You configure `tasty-discover` by passing options to the test driver file. ## No Arguments Example: `{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --debug #-}` - **--debug**: Output the contents of the generated module while testing. - **--tree-display**: Display the test output results hierarchically. ## With Arguments Example: `{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --modules="*CustomTest.hs" #-}` - **--modules**: Which test modules to discover (with glob pattern). - **--ignores**: Which test modules to ignore (with glob pattern). - **--generated-module**: The name of the generated test module. - **--ingredient**: Tasty ingredients to add to your test runner. It is also possible to override [tasty test options] with `-optF`: [tasty test options]: https://github.com/feuerbach/tasty#options ``` bash {-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-} ``` # Example Project See the [testing for this package] for a fully configured example. [testing for this package]: https://github.com/lwm/tasty-discover/tree/master/test # Change Log Please see the [CHANGELOG.md] for the latest changes. We try to keep [tagged releases] in our release process, if you care about that. [CHANGELOG.md]: https://github.com/lwm/tasty-discover/blob/master/CHANGELOG.md [tagged releases]: https://github.com/lwm/tasty-discover/releases # Deprecation Policy If a breaking change is implemented, you'll see a major version increase, an entry in the [change log] and a compile-time error with a deprecation warning and clear instructions on how to upgrade. Please do complain if we're doing this too much. [change log]: https://github.com/lwm/tasty-discover/blob/master/CHANGELOG.md # Contributing All contributions welcome! The continuous integration suite is pretty comprehensive, so just get hacking and add a test case - there are *plenty* of examples, so this should be simple - and I'll get to review your change ASAP. # Maintenance If you're interested in helping maintain this package, please let [@lwm] know! It doesn't take much time (max ~3 hours a month) and all we need to do is: * Triage issues that are raised. * Review pull requests from contributors. * Fix bugs when present. * Make releases. * Manage bounds issues on Stackage. You can [create an issue] or drop him a line at **lukewm AT riseup DOT NET**. [@lwm]: https://github.com/lwm [create an issue]: https://github.com/lwm/tasty-discover/issues/new # Acknowledgements Thanks to [hspec-discover] and [tasty-auto] for making this possible. A huge thanks to the growing list of [contributors]. [hspec-discover]: https://hspec.github.io/hspec-discover.html [tasty-auto]: https://github.com/minad/tasty-auto [contributors]: https://github.com/lwm/tasty-discover/graphs/contributors