tasty-discover-5.0.0/0000755000000000000000000000000007346545000012665 5ustar0000000000000000tasty-discover-5.0.0/CHANGELOG.md0000644000000000000000000001213107346545000014474 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/ # 5.0.0 [2022-07-08] - Fix tasty-hedgehog `testProperty` deprecation warning # 4.2.4 [2022-05-22] - Support for custom test libraries - Version module - Deduplicate imports in generated code - Rename library directory to src - Move existing library modules to Test.Discover.Internal # 4.2.3 [2022-05-21] - Added `--search-dir DIR` option - Adds an `--in-place` flag to write the generated driver to the source file. # 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-5.0.0/LICENSE0000644000000000000000000000203707346545000013674 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-5.0.0/README.md0000644000000000000000000002214407346545000014147 0ustar0000000000000000[![CircleCI](https://circleci.com/gh/haskell-works/tasty-discover/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/tasty-discover/tree/master) [![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) - [FAQ](#frequently-asked-questions) - [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. Remember to add your 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://git.coop/sol/hpack ``` yaml tests: test: main: "Driver.hs" source-dirs: "test" dependencies: - "base" ``` To ensure that `tasty-discover` is available even without installation, add this to the test suite in your cabal file: ``` build-tool-depends: tasty-discover:tasty-discover ``` See [`hpack` documentation](https://github.com/sol/hpack) for `stack` equivalent. # 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. - **tasty_**: Custom tests 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.Discover 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 -- SmallCheck property scprop_sortReverse :: [Int] -> Bool scprop_sortReverse list = sort list == sort (reverse list) -- Hspec specification spec_prelude :: Spec spec_prelude = describe "Prelude.head" $ do it "returns the first element of a list" $ do head [23 ..] `shouldBe` (23 :: Int) -- Custom test -- -- Write a test for anything with a Tasty instance -- -- In order to use this feature, you must add tasty-discover as a library dependency -- to your test component in the cabal file. -- -- The instance defined should not be an orphaned instance. A future version of -- tasty-discover may choose to define orphaned instances for popular test libraries. import Test.Tasty (testCase) import Test.Tasty.Discover (TestCase(..), descriptionOf) data CustomTest = CustomTest String Assertion instance Tasty CustomTest where tasty info (CustomTest prefix act) = pure $ testCase (prefix ++ descriptionOf info) act tasty_myTest :: CustomTest tasty_myTest = CustomTest "Custom: " $ pure () -- 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). - **--search-dir**: Where to look for tests. This is a directory relative to the location of the source file. By default, this is the directory of the source file." - **--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. - **--inplace**: Has the generated code written to the source file. It is also possible to override [tasty test options] with `-optF`: [tasty test options]: https://git.coop/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://git.coop/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://git.coop/lwm/tasty-discover/blob/master/CHANGELOG.md [tagged releases]: https://git.coop/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://git.coop/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. # Frequently Asked Questions ## Deleting Tests Breaks The Test Run This is a known limitation and has been reported. No fix is planned unless you have time. Please see [#145](https://git.coop/lwm/tasty-discover/issues/145) for more information. # Maintenance If you're interested in helping maintain this package, please let [@newhoggy] 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**. [@newhoggy]: https://twitter.com/newhoggy [create an issue]: https://github.com/haskell-works/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 tasty-discover-5.0.0/Setup.hs0000644000000000000000000000005607346545000014322 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-discover-5.0.0/executable/0000755000000000000000000000000007346545000015006 5ustar0000000000000000tasty-discover-5.0.0/executable/Main.hs0000644000000000000000000000330607346545000016230 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.FilePath (takeDirectory) import System.IO (IOMode(ReadMode), hGetContents, hPutStrLn, withFile, stderr) import Test.Tasty.Discover.Internal.Config (Config (..), parseConfig) import Test.Tasty.Discover.Internal.Driver (findTests, generateTestDriver) -- | Main function. main :: IO () main = do args <- getArgs name <- getProgName case args of src:_:dst:opts -> case parseConfig (takeDirectory src) name opts of Left err -> do hPutStrLn stderr err exitFailure Right config -> do tests <- findTests config let ingredients = tastyIngredients config moduleName = fromMaybe "Main" (generatedModuleName config) header <- readHeader src let output = generateTestDriver config moduleName ingredients src tests when (debug config) $ hPutStrLn stderr output when (inPlace config) $ writeFile src $ unlines $ header ++ [marker, output] writeFile dst $ "{-# LINE " ++ show (length header + 2) ++ " " ++ show src ++ " #-}\n" ++ output _ -> do hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" exitFailure where marker = "-- GENERATED BY tasty-discover" readHeader src = withFile src ReadMode $ \h -> do header <- takeWhile (marker /=) . lines <$> hGetContents h seq (length header) (return header) tasty-discover-5.0.0/src/Test/Tasty/0000755000000000000000000000000007346545000015477 5ustar0000000000000000tasty-discover-5.0.0/src/Test/Tasty/Discover.hs0000644000000000000000000000207707346545000017617 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Test.Tasty.Discover ( Tasty(..) , TastyInfo , name , description , nameOf , descriptionOf ) where import Data.Maybe import Data.Monoid import Test.Tasty.Discover.TastyInfo (TastyInfo) import qualified Test.Tasty as TT import qualified Test.Tasty.Discover.TastyInfo as TI class Tasty a where tasty :: TastyInfo -> a -> IO TT.TestTree instance Tasty TT.TestTree where tasty _ a = pure a instance Tasty [TT.TestTree] where tasty info a = pure $ TT.testGroup (descriptionOf info) a instance Tasty (IO TT.TestTree) where tasty _ a = a instance Tasty (IO [TT.TestTree]) where tasty info a = TT.testGroup (descriptionOf info) <$> a nameOf :: TastyInfo -> String nameOf info = (fromMaybe "" (getLast (TI.name info))) descriptionOf :: TastyInfo -> String descriptionOf info = (fromMaybe "" (getLast (TI.description info))) name :: String -> TastyInfo name n = mempty { TI.name = Last $ Just n } description :: String -> TastyInfo description n = mempty { TI.description = Last $ Just n } tasty-discover-5.0.0/src/Test/Tasty/Discover/Internal/0000755000000000000000000000000007346545000021031 5ustar0000000000000000tasty-discover-5.0.0/src/Test/Tasty/Discover/Internal/Config.hs0000644000000000000000000001233307346545000022574 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.Discover.Internal.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') import System.FilePath (()) -- | 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. , searchDir :: FilePath -- ^ Directory where to look for tests. , 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 , inPlace :: Bool -- ^ Whether the source file should be modified in-place. , 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 :: FilePath -> Config defaultConfig theSearchDir = Config Nothing Nothing theSearchDir Nothing Nothing [] [] [] False 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 :: FilePath -> String -> [String] -> Either String Config parseConfig srcDir prog args = case getOpt' Permute (options srcDir) args of (opts, rest, rest', []) -> let config = foldl (flip id) (defaultConfig srcDir) { 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 :: FilePath -> [OptDescr (Config -> Config)] options srcDir = [ 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 [] ["search-dir"] (ReqArg (\s c -> c {searchDir = srcDir s}) "DIR") "Directory where to look for tests relative to the directory of src. By default, this is the directory of src." , 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 [] ["in-place"] (NoArg $ \c -> c {inPlace = True}) "Whether the source file should be modified in-place" , 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-5.0.0/src/Test/Tasty/Discover/Internal/Driver.hs0000644000000000000000000001525707346545000022632 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Automatic test discovery and runner for the tasty framework. module Test.Tasty.Discover.Internal.Driver ( -- * Main Test Generator generateTestDriver -- * For Testing Purposes Only , ModuleTree (..) , findTests , mkModuleTree , showTests ) where import Data.List (dropWhileEnd, intercalate, isPrefixOf, nub, sort, stripPrefix) import Data.Maybe (fromMaybe) import System.FilePath (pathSeparator) import System.FilePath.Glob (compile, globDir1, match) import System.IO (IOMode (ReadMode), withFile) import Test.Tasty.Discover.Internal.Config (Config (..), GlobPattern) import Test.Tasty.Discover.Internal.Generator (Generator (..), Test (..), generators, getGenerators, mkTest, showSetup) import qualified Data.Map.Strict as M #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 defaultImports :: [String] defaultImports = [ "import Prelude" , "import qualified System.Environment as E" , "import qualified Test.Tasty as T" , "import qualified Test.Tasty.Ingredients as T" ] -- | 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)..] testKindImports = map generatorImports generators' :: [[String]] testImports = showImports (map ingredientImport is ++ map testModule tests) :: [String] in concat [ "{-# LANGUAGE FlexibleInstances #-}\n" , "\n" , "module " ++ modname ++ " (main, ingredients, tests) where\n" , "\n" , unlines $ nub $ sort $ mconcat (defaultImports:testKindImports) ++ testImports , "\n" , "{- HLINT ignore \"Use let\" -}\n" , "\n" , 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 = 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 :: Config -> IO [Test] findTests config = do let directory = searchDir config allModules <- filesByModuleGlob directory (modules config) let filtered = ignoreByModuleGlob allModules (ignores config) -- The files to scan need to be sorted or otherwise the output of -- findTests might not be deterministic sortedFiltered = sort filtered concat <$> traverse (extract directory) sortedFiltered where extract directory filePath = withFile filePath ReadMode $ \h -> do #if defined(mingw32_HOST_OS) -- Avoid internal error: hGetContents: invalid argument (invalid byte sequence)' non UTF-8 Windows hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure #endif tests <- extractTests (dropDirectory directory filePath) <$> hGetContents h seq (length tests) (return tests) 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 = sort $ map ("import qualified " ++) 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 const testNumVars tests 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 :: ([Char], (ModuleTree, [String])) -> [Char] showModule (mdl, (ModuleTree subMdls, [])) | M.size subMdls == 1 = case M.assocs subMdls of [(subMdl, (subSubTree, testVars))] -> showModule (mdl ++ '.' : subMdl, (subSubTree, testVars)) as -> error $ "Excepted number of submodules != 1. Found " <> show (length as) 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-5.0.0/src/Test/Tasty/Discover/Internal/Generator.hs0000644000000000000000000001321507346545000023315 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.Discover.Internal.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. , generatorImports :: [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 , tastyGenerator ] -- | Quickcheck group generator prefix. hedgehogPropertyGenerator :: Generator hedgehogPropertyGenerator = Generator { generatorPrefix = "hprop_" , generatorImports = ["import qualified Test.Tasty.Hedgehog as H", "import Data.String (fromString)"] , generatorClass = "" , generatorSetup = \t -> "pure $ H.testPropertyNamed \"" ++ name t ++ "\" (fromString \"" ++ qualifyFunction t ++ "\") " ++ qualifyFunction t } -- | Quickcheck group generator prefix. quickCheckPropertyGenerator :: Generator quickCheckPropertyGenerator = Generator { generatorPrefix = "prop_" , generatorImports = ["import qualified Test.Tasty.QuickCheck as QC"] , generatorClass = "" , generatorSetup = \t -> "pure $ QC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Smallcheck group generator prefix. smallCheckPropertyGenerator :: Generator smallCheckPropertyGenerator = Generator { generatorPrefix = "scprop_" , generatorImports = ["import qualified Test.Tasty.SmallCheck as SC"] , generatorClass = "" , generatorSetup = \t -> "pure $ SC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | HUnit generator prefix. hunitTestCaseGenerator :: Generator hunitTestCaseGenerator = Generator { generatorPrefix = "unit_" , generatorImports = ["import qualified Test.Tasty.HUnit as HU"] , 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_" , generatorImports = ["import qualified Test.Tasty.Hspec as HS"] , generatorClass = "" , generatorSetup = \t -> "HS.testSpec \"" ++ name t ++ "\" " ++ qualifyFunction t } -- | Tasty group generator prefix. tastyTestGroupGenerator :: Generator tastyTestGroupGenerator = Generator { generatorPrefix = "test_" , generatorImports = [] , 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 group generator prefix. tastyGenerator :: Generator tastyGenerator = Generator { generatorPrefix = "tasty_" , generatorImports = ["import qualified Test.Tasty.Discover as TD"] , generatorClass = [] , generatorSetup = \t -> "TD.tasty (TD.description \"" ++ name t ++ "\" <> TD.name \"" ++ qualifyFunction t ++ "\") " ++ qualifyFunction t } tasty-discover-5.0.0/src/Test/Tasty/Discover/0000755000000000000000000000000007346545000017255 5ustar0000000000000000tasty-discover-5.0.0/src/Test/Tasty/Discover/TastyInfo.hs0000644000000000000000000000074307346545000021535 0ustar0000000000000000module Test.Tasty.Discover.TastyInfo ( TastyInfo(..) ) where import Data.Monoid data TastyInfo = TastyInfo { name :: Last String , description :: Last String } deriving (Eq, Show) instance Semigroup TastyInfo where a <> b = TastyInfo { name = name a <> name b , description = description a <> description b } instance Monoid TastyInfo where mempty = TastyInfo { name = Last Nothing , description = Last Nothing } tasty-discover-5.0.0/src/Test/Tasty/Discover/Version.hs0000644000000000000000000000026007346545000021234 0ustar0000000000000000module Test.Tasty.Discover.Version ( version ) where import Data.Version (Version(..)) import qualified Paths_tasty_discover as P version :: Version version = P.version tasty-discover-5.0.0/tasty-discover.cabal0000644000000000000000000001346507346545000016642 0ustar0000000000000000cabal-version: 2.2 name: tasty-discover version: 5.0.0 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: https://github.com/haskell-works/tasty-discover bug-reports: https://github.com/haskell-works/tasty-discover/issues author: Luke Murphy maintainer: John Ky copyright: 2016 Luke Murphy 2020-2022 John Ky license: MIT license-file: LICENSE tested-with: GHC == 9.2.2, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4, GHC == 8.6.5 build-type: Simple extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/haskell-works/tasty-discover common base { build-depends: base >= 4.11 && < 5 } common bytestring { build-depends: bytestring >= 0.9 && < 1.0 } common containers { build-depends: containers >= 0.4 && < 1.0 } common directory { build-depends: directory >= 1.1 && < 2.0 } common filepath { build-depends: filepath >= 1.3 && < 2.0 } common Glob { build-depends: Glob >= 0.8 && < 1.0 } common hedgehog { build-depends: hedgehog >= 1.0 && < 2.0 } common hspec { build-depends: hspec >= 2.7 && < 2.10 } common hspec-core { build-depends: hspec-core >= 2.7.10 && < 2.11 } common tasty { build-depends: tasty >= 1.3 && < 2.0 } common tasty-discover { build-depends: tasty-discover >= 4.0 && < 5.0 } common tasty-golden { build-depends: tasty-golden >= 2.0 && < 3.0 } common tasty-hedgehog { build-depends: tasty-hedgehog >= 1.2 && < 2.0 } common tasty-hspec { build-depends: tasty-hspec >= 1.1 && < 1.3 } common tasty-hunit { build-depends: tasty-hunit >= 0.10 && < 0.11 } common tasty-quickcheck { build-depends: tasty-quickcheck >= 0.10 && < 0.11 } common tasty-smallcheck { build-depends: tasty-smallcheck >= 0.8 && < 1.0 } library exposed-modules: Test.Tasty.Discover Test.Tasty.Discover.Internal.Config Test.Tasty.Discover.Internal.Driver Test.Tasty.Discover.Internal.Generator Test.Tasty.Discover.TastyInfo Test.Tasty.Discover.Version other-modules: Paths_tasty_discover autogen-modules: Paths_tasty_discover hs-source-dirs: src ghc-options: -Wall build-depends: base >= 4.8 && < 5.0 , Glob >= 0.8 && < 1.0 , containers >= 0.4 && < 1.0 , directory >= 1.1 && < 2.0 , filepath >= 1.3 && < 2.0 , tasty >= 1.3 && < 2.0 default-language: Haskell2010 executable tasty-discover import: base , Glob , containers , directory , filepath main-is: executable/Main.hs autogen-modules: Paths_tasty_discover other-modules: Paths_tasty_discover ghc-options: -Wall build-depends: tasty-discover default-language: Haskell2010 test-suite tasty-discover-test import: base , Glob , bytestring , containers , directory , filepath , hedgehog , hspec , hspec-core , tasty , tasty-golden , tasty-hedgehog , tasty-hspec , tasty-hunit , tasty-quickcheck , tasty-smallcheck type: exitcode-stdio-1.0 main-is: Driver.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N other-modules: ConfigTest DiscoverTest SubMod.FooBaz SubMod.PropTest SubMod.SubSubMod.PropTest Paths_tasty_discover autogen-modules: Paths_tasty_discover hs-source-dirs: test ghc-options: -Wall build-depends: tasty-discover default-language: Haskell2010 build-tool-depends: tasty-discover:tasty-discover tasty-discover-5.0.0/test/0000755000000000000000000000000007346545000013644 5ustar0000000000000000tasty-discover-5.0.0/test/ConfigTest.hs0000644000000000000000000000656707346545000016263 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module ConfigTest where import Data.List (isInfixOf, sort) import Test.Tasty.Discover.Internal.Config import Test.Tasty.Discover.Internal.Driver (ModuleTree (..), findTests, generateTestDriver, mkModuleTree, showTests) import Test.Tasty.Discover.Internal.Generator (Test (..), mkTest) import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.Hspec.Core.Spec (Spec, describe, it) import Test.Hspec (shouldBe, shouldSatisfy) import qualified Data.Map.Strict as M spec_modules :: Spec spec_modules = describe "Test discovery" $ do it "Discovers tests" $ do let expectedTests = [ mkTest "PropTest.hs" "prop_additionAssociative" , mkTest "SubSubMod/PropTest.hs" "prop_additionCommutative" ] config = (defaultConfig "test/SubMod") { modules = Just "*Test.hs" } discoveredTests <- findTests config sort discoveredTests `shouldBe` sort expectedTests spec_ignores :: Spec spec_ignores = describe "Module ignore configuration" $ do it "Ignores tests in modules with the specified suffix" $ do let ignoreModuleConfig = (defaultConfig "test/SubMod") { ignores = Just "*.hs" } discoveredTests <- findTests ignoreModuleConfig discoveredTests `shouldBe` [] spec_badModuleGlob :: Spec spec_badModuleGlob = describe "Module suffix configuration" $ do it "Filters discovered tests by specified suffix" $ do let badGlobConfig = (defaultConfig "test/SubMod") { modules = Just "DoesntExist*.hs" } discoveredTests <- findTests badGlobConfig discoveredTests `shouldBe` [] spec_customModuleName :: Spec spec_customModuleName = describe "Module name configuration" $ do it "Creates a generated main function with the specified name" $ do let generatedModule = generateTestDriver (defaultConfig "test/") "FunkyModuleName" [] "test/" [] "FunkyModuleName" `shouldSatisfy` (`isInfixOf` generatedModule) unit_noTreeDisplayDefault :: IO () unit_noTreeDisplayDefault = do let config = defaultConfig "test/SubMod" tests <- findTests config let testNumVars = map (('t' :) . show) [(0::Int)..] trees = showTests config tests testNumVars length trees @?= 4 unit_treeDisplay :: IO () unit_treeDisplay = do let config = (defaultConfig "test/SubMod") { treeDisplay = True } tests <- findTests 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 (Test mdl "-", ) 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-5.0.0/test/DiscoverTest.hs0000644000000000000000000000761307346545000016625 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module DiscoverTest where import Data.ByteString.Lazy (ByteString) import Data.List import Data.String (IsString(..)) import Test.Hspec (shouldBe) import Test.Hspec.Core.Spec (Spec, describe, it) import Test.Tasty import Test.Tasty.Golden import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (Property, property) import qualified Hedgehog as H import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R import qualified Test.Tasty.Discover as TD import qualified Test.Tasty.Hedgehog as TH ------------------------------------------------------------------------------------------------ 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" $ do it "returns the first element of a list" $ do 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 = pure (map (\s -> testCase s $ pure ()) ["First input", "Second input"]) ------------------------------------------------------------------------------------------------ -- How to simultaneously support tasty-hedgehog <1.2 and ^>1.2 using a custom test newtype Property = Property { unProperty :: H.Property } instance TD.Tasty Property where tasty info (Property p) = pure $ #if MIN_VERSION_tasty_hedgehog(1, 2, 0) TH.testPropertyNamed (TD.nameOf info) (fromString (TD.descriptionOf info)) p #else TH.testProperty (TD.nameOf info) p #endif property :: HasCallStack => H.PropertyT IO () -> Property property = Property . H.property {- HLINT ignore "Avoid reverse" -} tasty_reverse :: Property tasty_reverse = property $ do xs <- H.forAll $ G.list (R.linear 0 100) G.alpha reverse (reverse xs) H.=== xs ------------------------------------------------------------------------------------------------ -- How to use the latest version of tasty-hedgehog {- HLINT ignore "Avoid reverse" -} hprop_reverse :: H.Property hprop_reverse = H.property $ do xs <- H.forAll $ G.list (R.linear 0 100) G.alpha reverse (reverse xs) H.=== xs ------------------------------------------------------------------------------------------------ -- How to add custom support for golden tests. data GoldenTest = GoldenTest FilePath (IO ByteString) instance TD.Tasty GoldenTest where tasty info (GoldenTest fp act) = pure $ goldenVsString (TD.descriptionOf info) fp act case_goldenTest :: GoldenTest case_goldenTest = GoldenTest "test/SubMod/example.golden" $ return "test" tasty-discover-5.0.0/test/Driver.hs0000644000000000000000000000665507346545000015447 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --in-place #-} -- GENERATED BY tasty-discover {-# LANGUAGE FlexibleInstances #-} module Main (main, ingredients, tests) where import Data.String (fromString) import Prelude import qualified ConfigTest import qualified DiscoverTest import qualified SubMod.FooBaz import qualified SubMod.PropTest import qualified SubMod.SubSubMod.PropTest import qualified System.Environment as E import qualified Test.Tasty as T import qualified Test.Tasty.Discover as TD import qualified Test.Tasty.HUnit as HU import qualified Test.Tasty.Hedgehog as H import qualified Test.Tasty.Hspec as HS import qualified Test.Tasty.Ingredients as T import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.SmallCheck as SC {- HLINT ignore "Use let" -} class TestGroup a where testGroup :: String -> a -> IO T.TestTree instance TestGroup T.TestTree where testGroup _ a = pure a instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a instance TestGroup (IO T.TestTree) where testGroup _ a = a instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a class TestCase a where testCase :: String -> a -> IO T.TestTree instance TestCase (IO ()) where testCase n = pure . HU.testCase n instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n tests :: IO T.TestTree tests = do t0 <- HS.testSpec "modules" ConfigTest.spec_modules t1 <- HS.testSpec "ignores" ConfigTest.spec_ignores t2 <- HS.testSpec "badModuleGlob" ConfigTest.spec_badModuleGlob t3 <- HS.testSpec "customModuleName" ConfigTest.spec_customModuleName t4 <- testCase "noTreeDisplayDefault" ConfigTest.unit_noTreeDisplayDefault t5 <- testCase "treeDisplay" ConfigTest.unit_treeDisplay t6 <- pure $ QC.testProperty "mkModuleTree" ConfigTest.prop_mkModuleTree t7 <- testCase "listCompare" DiscoverTest.unit_listCompare t8 <- pure $ QC.testProperty "additionCommutative" DiscoverTest.prop_additionCommutative t9 <- pure $ SC.testProperty "sortReverse" DiscoverTest.scprop_sortReverse t10 <- HS.testSpec "prelude" DiscoverTest.spec_prelude t11 <- testGroup "addition" DiscoverTest.test_addition t12 <- testGroup "multiplication" DiscoverTest.test_multiplication t13 <- testGroup "generateTree" DiscoverTest.test_generateTree t14 <- testGroup "generateTrees" DiscoverTest.test_generateTrees t15 <- TD.tasty (TD.description "reverse" <> TD.name "DiscoverTest.tasty_reverse") DiscoverTest.tasty_reverse t16 <- pure $ H.testPropertyNamed "reverse" (fromString "DiscoverTest.hprop_reverse") DiscoverTest.hprop_reverse t17 <- pure $ QC.testProperty "additionCommutative" SubMod.FooBaz.prop_additionCommutative t18 <- pure $ QC.testProperty "multiplationDistributiveOverAddition" SubMod.FooBaz.prop_multiplationDistributiveOverAddition t19 <- pure $ QC.testProperty "additionAssociative" SubMod.PropTest.prop_additionAssociative t20 <- pure $ QC.testProperty "additionCommutative" SubMod.SubSubMod.PropTest.prop_additionCommutative pure $ T.testGroup "test/Driver.hs" [t0,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19,t20] ingredients :: [T.Ingredient] ingredients = T.defaultIngredients main :: IO () main = do args <- E.getArgs E.withArgs ([] ++ args) $ tests >>= T.defaultMainWithIngredients ingredients tasty-discover-5.0.0/test/SubMod/0000755000000000000000000000000007346545000015035 5ustar0000000000000000tasty-discover-5.0.0/test/SubMod/FooBaz.hs0000644000000000000000000000043407346545000016552 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-5.0.0/test/SubMod/PropTest.hs0000644000000000000000000000022007346545000017143 0ustar0000000000000000module SubMod.PropTest where prop_additionAssociative :: Int -> Int -> Int -> Bool prop_additionAssociative a b c = (a + b) + c == a + (b + c) tasty-discover-5.0.0/test/SubMod/SubSubMod/0000755000000000000000000000000007346545000016700 5ustar0000000000000000tasty-discover-5.0.0/test/SubMod/SubSubMod/PropTest.hs0000644000000000000000000000020507346545000021011 0ustar0000000000000000module SubMod.SubSubMod.PropTest where prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a