packages feed

tasty-discover 4.2.4 → 5.2.0

raw patch · 20 files changed

Files

CHANGELOG.md view
@@ -8,6 +8,90 @@ [Keep a Changelog]: http://keepachangelog.com/ [Semantic Versioning]: http://semver.org/ +## [Unreleased]++### Added++### Fixed++### Changed++### Removed++# 5.2.0 [2025-10-25]++### Added+- `applySkips` function for skipping entire test trees with individual test visibility+  - Traverses test trees and replaces tests with skipped placeholders+  - Shows each test as `[SKIPPED]` in yellow when skip condition is met+  - Useful for platform-specific test suites with `Flavored (IO TestTree)`+  - Preserves test group structure while showing which tests would run+- Comprehensive platform expression tests covering all operators and edge cases+  - Added tests for `!darwin`, `!mingw32`, `!unix` negations+  - Added tests for complex AND/OR expressions+  - Added tests for edge cases like unknown platforms (freebsd)++### Changed+- Migrated release process to tag-triggered workflow+  - Release workflow now triggers when version tags (e.g., v5.2.0) are pushed+  - Removed automatic tag creation from CI+  - Updated release documentation to reflect tag-based process+- `--inplace` option now only overwrites file if content has changed+  - Prevents unnecessary file modification timestamps+  - Reduces build system churn when generated file is identical++# 5.1.0 [2025-08-10]++### Added+- Assertion newtype wrapper for HUnit-style assertions with comprehensive documentation and examples (see #74)+- Platform-specific test examples and documentation showing skip/platform usage (see #69)+- Support for GHC 9.12.2 in tested configurations (see #53)+- Reproduction test for symlink crash issue (see #38)+- New `--no-main` option for generating modules without main function (see #54)+- Support for custom tests with `Tasty` instances using `tasty_` prefix+- New `TastyInfo` type providing access to test metadata in custom tests+- **`Flavored` type**: General-purpose mechanism for transforming `TestTree`s generated by `tasty_` functions+  - Allows applying transformations like skipping, timeouts, metadata, grouping, etc.+  - Extensible design with `flavoring :: TestTree -> TestTree` transformation function+  - Integrates seamlessly with custom test types through `Tasty` instances+- **Skip test functionality**: Added `SkipTest` option type and `skip` function+  - `SkipTest` newtype with `IsOption` instance for Tasty options+  - `skip :: TestTree -> TestTree` function to skip any test tree+  - Skipped tests show as `[SKIPPED]` in yellow in test output+  - Works with `Flavored` type for advanced skip patterns+- Comprehensive documentation for all test type variations+- Step-by-step testing support for HUnit tests+- IO-based test generation for TestTrees+- AI development guidelines in AI_GUIDELINES.md+- Comprehensive coding style guide in CODING_STYLE.md+- Multiline block comment handling in test discovery (resolves #10)++### Fixed+- Fixed backup file import generation bug - prevents `.hs.orig` and `.hs.bak` files from being processed (see #58)+- Fixed directory handling in glob patterns - directories are now filtered out when using `--modules` flag (resolves #12)+- Fixed HLint warnings in generated code+- Fixed warnings in Generator.hs and added Unsafe.hs module+- Fixed broken links in documentation+- Fixed test discovery incorrectly finding tests inside `{- -}` block comments (resolves #10)++### Changed+- Enhanced documentation for skip and platform guidance (see #72)+- Cleaned up cabal file configuration+- Improved test discovery patterns from `*.hs*` to `*.hs` to avoid backup files+- Enhanced documentation with more test type examples+- Added regression tests for backup file handling and directory filtering+- Added preprocessing step to remove block comments before test discovery+- Enhanced test discovery with proper nested block comment support++### Removed+- Removed `project.sh` build script++# 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
README.md view
@@ -2,7 +2,7 @@ [![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)+[![GitHub license](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https://raw.githubusercontent.com/haskell-works/tasty-discover/main/LICENSE)  # tasty-discover @@ -10,16 +10,27 @@   * [Create Test Driver File](#create-test-driver-file)   * [Configure Cabal or Hpack Test Suite](#configure-cabal-or-hpack-test-suite) - [Write Tests](#write-tests)+  * [Test Transformations (Flavored, skip, platform)](#test-transformations-flavored-skip-platform)+    - [Flavored (test transformations)](#flavored-test-transformations)+    - [Skipping Tests](#skipping-tests)+    - [Platform-Specific Tests](#platform-specific-tests)+    - [Combining skip and platform](#combining-skip-and-platform)+    - [Using skip and platform (guidelines)](#using-skip-and-platform-guidelines)+  * [Comment Handling](#comment-handling) - [Customise Discovery](#customise-discovery)   * [No Arguments](#no-arguments)   * [With Arguments](#with-arguments)+  * [Custom Main Function](#custom-main-function) - [Example Project](#example-project) - [Change Log](#change-log) - [Deprecation Policy](#deprecation-policy) - [Contributing](#contributing) - [FAQ](#frequently-asked-questions) - [Maintenance](#maintenance)+- [Releasing](#releasing) - [Acknowledgements](#acknowledgements)+- [AI Guidelines](AI_GUIDELINES.md)+- [Coding Style](CODING_STYLE.md)  Haskell auto-magic test discovery and runner for the [tasty test framework]. @@ -31,6 +42,16 @@ files. Tasty ingredients are included along with various configuration options for different use cases. +**Recent improvements include:**+- New `--no-main` option for custom test runners+- **Platform-specific test filtering** with `platform` function and logical expressions+- **Skip test functionality** with `skip` function and yellow `[SKIPPED]` output+- **`Flavored` type** for general-purpose test transformations with extensible design+- Enhanced support for custom test types with `Tasty` instances+- Better handling of backup files and directories in test discovery+- Intelligent block comment handling to prevent false test discovery+- Comprehensive documentation with more test examples+ See below for full documentation and examples.  # Getting Started@@ -55,15 +76,11 @@ ``` {-# 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+  type: exitcode-stdio-1.0   main-is: Driver.hs   hs-source-dirs: test   build-depends: base@@ -71,7 +88,7 @@  If you use [hpack], that might look like: -[hpack]: https://git.coop/sol/hpack+[hpack]: https://github.com/sol/hpack  ``` yaml tests:@@ -103,7 +120,7 @@   - **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+  - **tasty_**: Custom tests with [Tasty](http://hackage.haskell.org/package/tasty) instances.  Here is an example test module with a bunch of different tests: @@ -118,11 +135,27 @@ import Test.Tasty.HUnit import Test.Tasty.Hspec import Test.Tasty.QuickCheck+import Test.Tasty.SmallCheck+import qualified Test.Tasty.Hedgehog as TH+import qualified Hedgehog as H+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R  -- HUnit test case unit_listCompare :: IO () unit_listCompare = [1, 2, 3] `compare` [1,2] @?= GT +-- HUnit test case with additional info+unit_listInfo :: IO String+unit_listInfo = return "This test provides info"++-- HUnit test case with steps+unit_listSteps :: (String -> IO ()) -> IO ()+unit_listSteps step = do+  step "Setting up test data"+  step "Running the test"+  [1, 2, 3] `compare` [1,2] @?= GT+ -- QuickCheck property prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a@@ -131,23 +164,46 @@ scprop_sortReverse :: [Int] -> Bool scprop_sortReverse list = sort list == sort (reverse list) +-- Hedgehog property+hprop_reverseReverse :: H.Property+hprop_reverseReverse = H.property $ do+  xs <- H.forAll $ G.list (R.linear 0 100) G.alpha+  reverse (reverse xs) H.=== xs+ -- 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+-- Simple Tasty TestTree+test_addition :: TestTree+test_addition = testProperty "Addition commutes" $ \(a :: Int) (b :: Int) -> a + b == b + a++-- List of Tasty TestTrees+test_multiplication :: [TestTree]+test_multiplication =+  [ testProperty "Multiplication commutes" $ \(a :: Int) (b :: Int) -> a * b == b * a+  , testProperty "One is identity" $ \(a :: Int) -> a * 1 == a+  ]++-- IO Tasty TestTree+test_generateTree :: IO TestTree+test_generateTree = do+  input <- pure "Some input"+  pure $ testCase input $ pure ()++-- IO List of Tasty TestTrees+test_generateTrees :: IO [TestTree]+test_generateTrees = do+  inputs <- pure ["First input", "Second input"]+  pure $ map (\s -> testCase s $ pure ()) inputs++-- Custom test with Tasty instance -- -- 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)+-- In order to use Flavored with tasty_ functions, add tasty-discover as a library+-- dependency to your test component in the cabal file.  data CustomTest = CustomTest String Assertion @@ -158,23 +214,391 @@ tasty_myTest :: CustomTest tasty_myTest = CustomTest "Custom: " $ pure () --- Tasty TestTree-test_multiplication :: [TestTree]-test_multiplication = [testProperty "One is identity" $ \(a :: Int) -> a * 1 == a]+-- Custom Tasty TestTree (can be any TestTree)+tasty_customGroup :: TestTree+tasty_customGroup = testGroup "Custom Test Group"+  [ testCase "nested test 1" $ return ()+  , testCase "nested test 2" $ (1 + 1) @?= (2 :: Int)+  ]+``` --- Tasty IO TestTree-test_generateTree :: IO TestTree-test_generateTree = do-  input <- pure "Some input"-  pure $ testCase input $ pure ()+## Test Transformations (Flavored, skip, platform) --- Tasty IO [TestTree]-test_generateTrees :: IO [TestTree]-test_generateTrees = do-  inputs <- pure ["First input", "Second input"]-  pure $ map (\s -> testCase s $ pure ()) inputs+This section covers how to transform tests using the Flavored pattern and how to apply skip and platform filters effectively.++### Flavored (test transformations)++The `Flavored` type provides a general-purpose mechanism for transforming `TestTree`s generated by `tasty_` functions before they are added to the test suite. This allows you to apply various options and modifications to your tests.++You can create flavored tests using the `flavored` constructor:++```haskell+flavored :: (TestTree -> TestTree) -> a -> Flavored a ``` +#### Examples++```haskell+import Test.Tasty.Discover (Flavored, flavored, skip)++-- Skip a custom property test+tasty_skipProperty :: Flavored Property+tasty_skipProperty = flavored skip $ property $ do+  -- This test will be skipped and show as [SKIPPED] in yellow+  H.failure+```++When tests are skipped, they will show as `[SKIPPED]` in yellow in the test output and won't actually execute.++### Skipping Tests++You can skip tests using the skip functionality provided by tasty-discover. There are multiple ways to skip tests:++For a high-level overview of when to use flavored vs direct application, see+[Using skip and platform (guidelines)](#using-skip-and-platform-guidelines).++#### Using the `skip` function++You can use the `skip` function to skip any TestTree:++```haskell+import Test.Tasty.Discover (skip)++-- Skip a simple test+test_skipThis :: TestTree+test_skipThis = skip $ testCase "this will be skipped" $ pure ()++-- Skip a property test+prop_skipThis :: Property -> TestTree+prop_skipThis p = skip $ testProperty "skipped property" p+```++**Potential future uses:**+The `Flavored` mechanism is designed to be extensible and could be used for other `TestTree` transformations such as:+- Setting test timeouts+- Adding test metadata or descriptions+- Grouping tests under custom names+- Setting resource dependencies+- Applying multiple transformations in sequence++#### Important: How to skip a tasty_ test++Guideline (TL;DR): To skip a `tasty_` test so it shows `[SKIPPED]` and doesn’t run, wrap it with `flavored skip`:++```haskell+import Test.Tasty.Discover (Flavored, flavored, skip)++-- Skips at the TestTree level (preferred for tasty_ tests)+tasty_mySkipped :: Flavored TestTree+tasty_mySkipped = flavored skip $ testCase "will be skipped" $ pure ()+```++Details (why this matters): Applying `skip` directly to an already-constructed+`TestTree` marks only that subtree as skipped. The test body can detect it via+`askOption`, but the outer `Tasty` instance (used by `tasty_` functions) may not+render a top-level `[SKIPPED]` placeholder because the option is applied after+the instance decides how to wrap the node. Using `flavored skip` applies the+transformation early so the instance can short-circuit and substitute a skipped+placeholder.++For completeness, a direct `skip` example that observes the option inside the test:++```haskell+-- Direct skip on a TestTree: the test can read SkipTest via askOption, but the+-- outer instance may not show a top-level [SKIPPED] marker for this node.+test_directSkip :: TestTree+test_directSkip = skip $ askOption $ \(TD.SkipTest shouldSkip) ->+  testCase "observes SkipTest inside" $ assertBool "expected SkipTest" shouldSkip+```++Using `Flavored` ensures the `skip` is visible to the `Tasty` instance early enough to short-circuit with a skipped placeholder.++```++### Platform-Specific Tests++You can conditionally run tests based on the current operating platform using the `platform` function provided by tasty-discover. This is useful for tests that only work on specific operating systems or need to be excluded from certain platforms.++For general guidance and composition patterns with `skip`, see+[Using skip and platform (guidelines)](#using-skip-and-platform-guidelines).++The `platform` function takes a platform expression string and a `TestTree`, returning a `TestTree` that will only run if the expression evaluates to true for the current platform:++```haskell+import Test.Tasty.Discover (platform)++-- Run only on Linux+tasty_linuxOnly :: TestTree+tasty_linuxOnly = platform "linux" $ testCase "Linux-specific functionality" $ do+  -- This test only runs on Linux+  pure ()++-- Run on all platforms except Windows  +tasty_notWindows :: TestTree  +tasty_notWindows = platform "!windows" $ testCase "Non-Windows functionality" $ do+  -- This test runs on all platforms except Windows+  pure ()++-- Run on Unix-like systems (Linux or Darwin)+tasty_unixLike :: TestTree+tasty_unixLike = platform "unix" $ testCase "Unix-like systems" $ do+  -- This test runs on Linux and Darwin (Unix-like systems)+  pure ()+```++#### Platform Expression Syntax++Platform expressions support the following syntax:++**Platform Names:**+- `"linux"` - Linux systems+- `"darwin"` - macOS systems +- `"windows"` - Windows systems (mapped to "mingw32" internally)+- `"mingw32"` - Windows systems (actual System.Info.os value)+- `"unix"` - Unix-like systems (matches both "linux" and "darwin")++**Logical Operators:**+- `"!"` (NOT) - Negation, e.g., `"!windows"` means "not Windows"+- `"&"` (AND) - Conjunction, e.g., `"!windows & !darwin"` means "neither Windows nor Darwin"+- `"|"` (OR) - Disjunction, e.g., `"linux | darwin"` means "Linux or Darwin"++**Complex Examples:**+```haskell+-- Run on platforms that are neither Windows nor Darwin (e.g., Linux)+tasty_complexPlatform1 :: TestTree+tasty_complexPlatform1 = platform "!windows & !darwin" $ testCase "Neither Windows nor Darwin" $ do+  pure ()++-- Run on either Linux or Darwin, but not Windows+tasty_complexPlatform2 :: TestTree+tasty_complexPlatform2 = platform "linux | darwin" $ testCase "Linux or Darwin only" $ do+  pure ()+```++#### Using `Flavored` with Platform Filtering++You can combine platform filtering with other test transformations using the `Flavored` type:++```haskell+import Test.Tasty.Discover (Flavored, flavored, platform)++-- Apply platform filtering to custom test types+tasty_platformFlavored :: Flavored TestTree+tasty_platformFlavored = flavored (platform "!windows") $ testCase "Advanced platform test" $ do+  pure ()++-- Platform-specific property test+tasty_platformProperty :: Flavored Property  +tasty_platformProperty = flavored (platform "unix") $ property $ do+  -- This hedgehog property only runs on Unix-like systems+  x <- H.forAll $ G.int (R.linear 1 100)+  x H.=== x+```++#### Combining skip and platform++Platform filtering can be combined with other tasty-discover features:++```haskell+-- Platform filtering with test skipping+tasty_platformAndSkip :: TestTree+tasty_platformAndSkip = platform "linux" $ skip $ testCase "Linux test that's also skipped" $ do+  -- This would only run on Linux, but it's also skipped+  pure ()++-- Platform filtering with test groups+tasty_platformGroup :: TestTree+tasty_platformGroup = platform "unix" $ testGroup "Unix-only tests"+  [ testCase "Unix test 1" $ pure ()+  , testCase "Unix test 2" $ pure ()+  , testProperty "Unix property" $ \(x :: Int) -> x >= 0 || x < 0+  ]+```++Platform filtering works by checking the current platform against the expression at runtime. If the expression evaluates to `False`, the test is automatically skipped using the same mechanism as the `skip` function.++#### Skipping entire test trees with `applySkips`++When you want to skip an entire test tree (such as a group of tests) and have each individual test show as `[SKIPPED]` in the output, use the `applySkips` function:++```haskell+import Test.Tasty.Discover (Flavored, flavored, platform, applySkips)++-- Skip an entire test group on Darwin+tasty_testTree_no_darwin :: Flavored (IO TestTree)+tasty_testTree_no_darwin =+  flavored (platform "!darwin") $ pure $+    applySkips $ testGroup "Non-Darwin group"+      [ testProperty "Test 1" $ \(x :: Int) -> x == x+      , testCase "Test 2" $ pure ()+      , testProperty "Test 3" $ \(x :: Int) -> x >= 0 || x < 0+      ]+```++On Darwin, this will display all tests as skipped in yellow:++```+Non-Darwin group+  Test 1 [SKIPPED]: OK+  Test 2 [SKIPPED]: OK+  Test 3 [SKIPPED]: OK+```++The `applySkips` function:+- Checks the `SkipTest` option (set by functions like `skip` or `platform`)+- Traverses the entire test tree and replaces each individual test with a skipped placeholder+- Preserves the test group structure+- Shows `[SKIPPED]` in yellow for each test++This is particularly useful for platform-specific test suites where you want to see which tests would run on other platforms, rather than hiding the entire group.++### Using skip and platform (guidelines)++TL;DR:+- For tests exposed via `tasty_` functions, prefer the `Flavored` pattern to apply+  transformations like `skip` and `platform` so they take effect at the TestTree level and can short-circuit execution.+- Applying `skip` directly to an already-constructed `TestTree` marks the subtree as skipped. The test can observe this via `askOption`, but the outer `Tasty` instance may not show a top-level `[SKIPPED]` placeholder.++Examples:++```haskell+import Test.Tasty.Discover (Flavored, flavored, skip, platform)+import Test.Tasty (TestTree, testCase)++-- Skip (preferred for tasty_ tests):+tasty_mySkipped :: Flavored TestTree+tasty_mySkipped = flavored skip $ testCase "will be skipped" $ pure ()++-- Platform filter with Flavored:+tasty_linuxOnly :: Flavored TestTree+tasty_linuxOnly = flavored (platform "linux") $ testCase "Linux only" $ pure ()++-- Compose platform and skip:+tasty_linuxButSkipped :: Flavored TestTree+tasty_linuxButSkipped = flavored (platform "linux") $ flavored skip $ testCase "won't run" $ pure ()++-- Direct skip on a TestTree (observed inside the test):+test_directSkip :: TestTree+test_directSkip = skip $ askOption $ \(TD.SkipTest shouldSkip) ->+  testCase "observes SkipTest inside" $ assertBool "expected SkipTest" shouldSkip+```++Platform expressions:+- Names: "linux", "darwin", "windows" (mapped to "mingw32"), "mingw32", and "unix" (matches both linux and darwin)+- Operators: `!` (NOT), `&` (AND), `|` (OR)+- Examples:+  - `platform "!windows & !darwin"` — neither Windows nor Darwin+  - `platform "linux | darwin"` — Linux or Darwin+  - `platform "unix"` — Linux or Darwin++## Test Type Variations++### HUnit Tests (`unit_` prefix)++The `unit_` prefix supports three different function signatures:+  ### Tasty TestTrees (`test_` prefix)+- `unit_testName :: IO ()` - Basic test case+- `unit_testName :: IO String` - Test case that provides additional info+- `unit_testName :: (String -> IO ()) -> IO ()` - Test case with steps++### Tasty TestTrees (`test_` prefix)++The `test_` prefix supports four different function signatures:++- `test_testName :: TestTree` - A single test tree+- `test_testName :: [TestTree]` - A list of test trees (automatically grouped)+- `test_testName :: IO TestTree` - A test tree generated in IO+- `test_testName :: IO [TestTree]` - A list of test trees generated in IO++### Custom Tests (`tasty_` prefix)++The `tasty_` prefix works with any type that has a `Tasty` instance:++- Built-in instances for `TestTree`, `[TestTree]`, `IO TestTree`, `IO [TestTree]`+- Custom instances for your own data types+- Provides access to test metadata through `TastyInfo`++### Organizing Tests with `testGroup`++The `testGroup` function is Tasty's way of organizing tests into hierarchical groups. You can use it in several ways:++**In `test_` functions:**+```haskell+test_arithmeticTests :: TestTree+test_arithmeticTests = testGroup "Arithmetic Operations"+  [ testCase "addition" $ 2 + 2 @?= 4+  , testCase "multiplication" $ 3 * 4 @?= 12+  , testProperty "commutativity" $ \a b -> a + b == b + (a :: Int)+  ]+```++**In `tasty_` functions:**+```haskell+tasty_myTestSuite :: TestTree+tasty_myTestSuite = testGroup "My Test Suite"+  [ testGroup "Unit Tests"+      [ testCase "test 1" $ pure ()+      , testCase "test 2" $ pure ()+      ]+  , testGroup "Properties"+      [ testProperty "prop 1" $ \x -> x == (x :: Int)+      ]+  ]+```++**In list form with `test_` functions:**+```haskell+test_groupedTests :: [TestTree]+test_groupedTests =+  [ testGroup "Group 1" [testCase "test A" $ pure ()]+  , testGroup "Group 2" [testCase "test B" $ pure ()]+  ]+```++This creates nested test hierarchies that make test output more organized and easier to navigate.++## Comment Handling++`tasty-discover` intelligently handles Haskell comments during test discovery to prevent false positives:++### Block Comments++Tests inside multiline block comments are automatically ignored:++```haskell+module MyTest where++-- This test will be discovered+unit_validTest :: IO ()+unit_validTest = pure ()++{- This test will be ignored+unit_commentedOut :: IO ()+unit_commentedOut = pure ()+-}++{- Nested comments are also handled correctly+{- Even deeply nested ones+unit_deeplyNested :: IO ()+unit_deeplyNested = pure ()+-}+unit_alsoIgnored :: IO ()+unit_alsoIgnored = pure ()+-}+```++### Line Comments++Line comments (starting with `--`) are handled by the Haskell lexer and don't interfere with test discovery:++```haskell+-- unit_thisIsIgnored :: IO ()+unit_thisIsFound :: IO ()  -- This test will be discovered+unit_thisIsFound = pure ()+```++This feature prevents compilation errors that would occur if `tasty-discover` tried to reference tests that are commented out, making it easier to temporarily disable tests during development.+ # Customise Discovery  You configure `tasty-discover` by passing options to the test driver file.@@ -185,6 +609,7 @@    - **--debug**: Output the contents of the generated module while testing.   - **--tree-display**: Display the test output results hierarchically.+  - **--no-main**: Generate a module without a main function, exporting `tests` and `ingredients` instead.  ## With Arguments @@ -201,17 +626,68 @@  It is also possible to override [tasty test options] with `-optF`: -[tasty test options]: https://git.coop/feuerbach/tasty#options+[tasty test options]: https://github.com/feuerbach/tasty#options  ``` bash {-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-} ``` +## Custom Main Function++The `--no-main` option allows you to write your own custom main function while still using tasty-discover for test discovery. This is useful when you need to:++- Apply custom test transformations or wrappers+- Add custom logging or output formatting+- Integrate with custom test runners or CI systems+- Control exactly how tests are executed++### Example Usage++Create your test discovery file (e.g., `test/Tests.hs`):++```haskell+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --no-main -optF --generated-module -optF Tests #-}+```++Then create your custom main file (e.g., `test/Main.hs`):++```haskell+module Main where++import qualified Tests+import qualified Test.Tasty as T++main :: IO ()+main = do+  putStrLn "=== Custom Test Runner ==="++  -- Get discovered tests and ingredients+  discoveredTests <- Tests.tests++  -- Apply custom transformations+  let wrappedTests = T.testGroup "My Custom Tests" [discoveredTests]++  -- Run with custom configuration+  T.defaultMainWithIngredients Tests.ingredients wrappedTests+```++Configure your cabal test suite to use the custom main:++```+test-suite my-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules: Tests+  hs-source-dirs: test+  build-depends: base, tasty+  build-tool-depends: tasty-discover:tasty-discover+```+ # 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+[testing for this package]: https://github.com/haskell-works/tasty-discover/tree/main/test  # Change Log @@ -219,9 +695,46 @@  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+[CHANGELOG.md]: https://github.com/haskell-works/tasty-discover/blob/main/CHANGELOG.md+[tagged releases]: https://github.com/haskell-works/tasty-discover/releases +# Releasing++This project's release flow is automated via GitHub Actions and triggered by pushing version tags.++Release checklist:++1) Prepare notes+- Update `CHANGELOG.md`: move items from "Unreleased" to a new version section with the current date.++2) Bump version+- Edit `tasty-discover.cabal` and set `version:` to the new version (e.g., `5.x.y`).++3) Commit changes+- Commit the changes: `git commit -m "Release X.Y.Z"`+- Push the commit: `git push origin main`++4) Create and push tag+- Create a git tag: `git tag -a vX.Y.Z -m "Release version X.Y.Z"`+- Push the tag: `git push origin vX.Y.Z`++5) CI does the rest (automated)+- When the tag is pushed, GitHub Actions automatically:+  - Runs the full test suite+  - Validates the cabal project with `cabal check`+  - Builds source distributions (`cabal v2-sdist`)+  - Uploads to Hackage (requires repo secrets `HACKAGE_USER`/`HACKAGE_PASS`)+  - Creates a draft GitHub Release for the tag++6) Publish release+- Go to https://github.com/haskell-works/tasty-discover/releases+- Edit the draft GitHub Release notes if needed and publish++Notes:+- The workflow is defined in `.github/workflows/haskell.yml`.+- The release workflow only triggers on tags matching `v[0-9]+.[0-9]+.[0-9]+` (e.g., v5.2.0).+- Keep `tested-with` in the cabal file up to date with CI's GHC matrix.+ # Deprecation Policy  If a breaking change is implemented, you'll see a major version increase, an@@ -229,7 +742,7 @@ 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+[change log]: https://github.com/haskell-works/tasty-discover/blob/main/CHANGELOG.md  # Contributing @@ -237,40 +750,17 @@ 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. +Please follow the guidelines in [CODING_STYLE.md](CODING_STYLE.md) for consistent code formatting and patterns.++For AI assistants and detailed development guidelines, see [AI_GUIDELINES.md](AI_GUIDELINES.md).+ # 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.--## Deprecation warnings--If you see the `testProperty` deprecation warnings like the following:--```-test/Driver.hs:77:17: warning: [-Wdeprecations]-    In the use of ‘testProperty’ (imported from Test.Tasty.Hedgehog):-    Deprecated: "testProperty will cause Hedgehog to provide incorrect instructions for re-checking properties"-   |-77 |   t16 <- pure $ H.testProperty "reverse" DiscoverTest.hprop_reverse-   |                 ^^^^^^^^^^^^^^-```--There are two ways to fix it:--One is to suppress the warning.  This can be done for example with an adjustment to the-Driver preprocessing with the `-Wno-deprecations` option:--```-{-# OPTIONS_GHC -Wno-deprecations -F -pgmF tasty-discover -optF --hide-successes #-}-```--Taking this option, whilst quick an easy, risks missing important deprecation warnings however.--The recommended option is define a `Tasty` type class instance for hedgehog.  An example can be-found in `DiscoverTest` module.+Please see [#145](https://github.com/haskell-works/tasty-discover/issues/145) for more information.  # Maintenance 
+ app/Main.hs view
@@ -0,0 +1,50 @@+-- | 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+          -- Write in-place only when content differs (no temp file)+          when (inPlace config) $ do+            let newContent = unlines $ header ++ [marker, output]+            -- Strictly read the existing file so the handle is closed before we write (important on Windows)+            oldContent <- withFile src ReadMode $ \h -> do+              s <- hGetContents h+              length s `seq` return s+            when (oldContent /= newContent) $ writeFile src newContent+          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)
− executable/Main.hs
@@ -1,43 +0,0 @@--- | 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)
src/Test/Tasty/Discover.hs view
@@ -1,21 +1,77 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}  module Test.Tasty.Discover   ( Tasty(..)   , TastyInfo+  , SkipTest(..)+  , Flavored(..)+  , flavored   , name   , description   , nameOf   , descriptionOf+  , skip+  , applySkips+  , platform+  , evaluatePlatformExpression   ) where  import Data.Maybe import Data.Monoid+import System.Console.ANSI (Color(..), ColorIntensity(..), ConsoleLayer(..), SGR(..), setSGRCode)+import System.Info (os) import Test.Tasty.Discover.TastyInfo (TastyInfo)+import Test.Tasty.Discover.Internal.Config (SkipTest(..))  import qualified Test.Tasty as TT+import qualified Test.Tasty.Runners as TR+import qualified Test.Tasty.Providers as TP import qualified Test.Tasty.Discover.TastyInfo as TI +{- $skipPlatform+Guidelines for using 'skip' and 'platform'+-----------------------------------------++TL;DR:+- For tests exposed via @tasty_@ functions, prefer using the 'Flavored' pattern to apply+  transformations like 'skip' and 'platform' so they take effect at the TestTree level.+- Directly applying 'skip' to an already-constructed 'TT.TestTree' marks the subtree as+  skipped (the test can observe 'SkipTest' via 'TT.askOption'), but the outer 'Tasty'+  instance may not replace it with a top-level "[SKIPPED]" node.++Patterns:+- Skip with 'Flavored':++@+tasty_mySkipped :: Flavored TT.TestTree+tasty_mySkipped = flavored skip $ TT.testCase "will be skipped" $ pure ()+@++-+@+tasty_linuxOnly :: Flavored TT.TestTree+tasty_linuxOnly = flavored (platform "linux") $ TT.testCase "Linux only" $ pure ()+@++Platform expressions:+- Names: @"linux"@, @"darwin"@, @"windows"@ (mapped to @"mingw32"@), @"mingw32"@, and @"unix"@ (matches linux|darwin)+- Operators: NOT @!@, AND @&@, OR @|@+-- Examples:++@+platform "!windows & !darwin"  -- neither Windows nor Darwin+platform "linux | darwin"       -- Linux or Darwin+platform "unix"                 -- Linux or Darwin+@++Combining:+- You can compose transformations: e.g., @flavored (platform "linux") . flavored skip@+  or wrap once with a composed function @flavored (platform "linux" . skip)@.++See 'skip' and 'platform' for function-specific details.+-}+ class Tasty a where   tasty :: TastyInfo -> a -> IO TT.TestTree @@ -31,11 +87,44 @@ instance Tasty (IO [TT.TestTree]) where   tasty info a = TT.testGroup (descriptionOf info) <$> a +-- | A general-purpose wrapper for transforming TestTrees generated by tasty_ functions.+--+-- The Flavored type allows you to apply transformations to test trees before they+-- are added to the test suite. This enables applying various options and modifications+-- such as skipping tests, setting timeouts, adding metadata, grouping, etc.+--+-- Example usage:+-- @+-- -- Skip a test+-- tasty_skipThis :: Flavored Property+-- tasty_skipThis = flavored skip $ property $ do+--   -- This test will be skipped+--   H.failure+-- @+data Flavored a = Flavored+  { flavoring :: TT.TestTree -> TT.TestTree   -- ^ Transformation function to apply+  , unFlavored :: a                           -- ^ The wrapped test value+  }++-- | Create a Flavored wrapper with a specific transformation function.+--+-- @flavored f a@ applies transformation @f@ to the TestTree generated from @a@.+flavored :: (TT.TestTree -> TT.TestTree) -> a -> Flavored a+flavored f a = Flavored f a++instance Tasty a => Tasty (Flavored a) where+  tasty :: TastyInfo -> Flavored a -> IO TT.TestTree+  tasty info (Flavored f a) = do+    testTree <- tasty info a+    pure $ f testTree+ nameOf :: TastyInfo -> String-nameOf info = (fromMaybe "<unnamed>" (getLast (TI.name info)))+nameOf info =+  fromMaybe "<unnamed>" (getLast (TI.name info))  descriptionOf :: TastyInfo -> String-descriptionOf info = (fromMaybe "<undescribed>" (getLast (TI.description info)))+descriptionOf info =+  fromMaybe "<undescribed>" (getLast (TI.description info))  name :: String -> TastyInfo name n = mempty@@ -46,3 +135,226 @@ description n = mempty   { TI.description = Last $ Just n   }++-- | Mark a test tree to be skipped by setting the SkipTest option to True.+--+-- Usage guidelines: see the @Guidelines for using 'skip' and 'platform'@ section ('skipPlatform').+-- In short, for @tasty_@ tests prefer 'flavored' 'skip' to let the outer 'Tasty' instance+-- short-circuit at the TestTree level. Direct 'skip' on a pre-built tree applies the option+-- to the subtree; the test can still observe 'SkipTest' via 'TT.askOption'.+--+-- Examples:+-- @+-- -- Direct usage on a TestTree (the test can read SkipTest via askOption)+-- test_directSkip :: TestTree+-- test_directSkip = skip $ testCase "will be skipped" $ pure ()+--+-- -- Preferred for tasty_ tests: apply at the right stage using Flavored+-- tasty_skipProperty :: Flavored Property+-- tasty_skipProperty = flavored skip $ property $ do+--   -- This property will be skipped+--   H.failure+-- @+skip :: TT.TestTree -> TT.TestTree+skip = TT.adjustOption (const (SkipTest True))++-- | Transform a TestTree to apply skipping behavior throughout the entire tree.+--+-- This function wraps a TestTree so that when the 'SkipTest' option is set to 'True',+-- all individual tests within the tree are replaced with skipped placeholder tests.+-- This is useful when you want to conditionally skip an entire group of tests while+-- still showing each test as skipped in the output.+--+-- The function works by:+--+-- * Checking the 'SkipTest' option via 'TT.askOption'+-- * If skipping is enabled, using 'TT.foldTestTree' to traverse the tree and rebuild it with:+--+--     * All single tests replaced with test cases showing "[SKIPPED]"+--     * Test groups preserved with their structure intact+--     * Resources skipped (not acquired)+--+-- * If skipping is disabled, returning the tree unchanged+--+-- This is particularly useful in combination with 'platform' for platform-specific test suites:+--+-- @+-- tasty_testTree_no_darwin :: Flavored (IO TestTree)+-- tasty_testTree_no_darwin =+--   flavored (platform "!darwin") $ pure $ applySkips $ testGroup "Non-Darwin group"+--     [ testProperty "Test 1" $ \\(x :: Int) -> x == x+--     , testCase "Test 2" $ pure ()+--     ]+-- @+--+-- On Darwin, this will show:+--+-- @+-- Non-Darwin group+--   Test 1 [SKIPPED]: OK+--   Test 2 [SKIPPED]: OK+-- @+--+-- @since 5.1.0+-- | A simple test type for skipped tests+data SkippedTest = SkippedTest+  deriving stock (Show, Eq)++instance TP.IsTest SkippedTest where+  run _ _ _ = return $ TP.testPassed ""+  testOptions = return []++applySkips :: TT.TestTree -> TT.TestTree+applySkips tree = TT.askOption $ \(SkipTest shouldSkip) ->+  if shouldSkip+    then transformTree tree+    else tree+  where+    yellowText :: String -> String+    yellowText text = setSGRCode [SetColor Foreground Vivid Yellow] ++ text ++ setSGRCode [Reset]++    transformTree :: TT.TestTree -> TT.TestTree+    transformTree t = case TR.foldTestTree+      TR.TreeFold+        { TR.foldSingle = \_ testName _ -> [TP.singleTest (testName ++ " " ++ yellowText "[SKIPPED]") SkippedTest]+        , TR.foldGroup = \_ groupName trees -> [TT.testGroup groupName (concat trees)]+        , TR.foldResource = \_ _ _ -> []+        , TR.foldAfter = \_ _ _ trees -> trees+        }+      mempty+      t of+        [result] -> result+        results -> TT.testGroup "" results++-- | Conditionally run a test based on a platform expression.+--+-- Usage guidelines, syntax, and examples: see the @Guidelines for using 'skip' and 'platform'@+-- section ('skipPlatform').+--+-- The expression supports logical operations with platform names:+-- - Platform names: "linux", "darwin", "mingw32", "windows", "unix"+-- - Negation: "!platform" (not on platform)  +-- - Conjunction: "platform1 & platform2" (on both platforms)+-- - Disjunction: "platform1 | platform2" (on either platform)+-- - Parentheses: "(platform1 | platform2) & !platform3"+--+-- Examples:+-- @+-- -- Only on Linux+-- test_linuxOnly :: TestTree+-- test_linuxOnly = platform "linux" $ testCase "Linux only" $ pure ()+--+-- -- Not on Windows or macOS+-- test_notWinMac :: TestTree  +-- test_notWinMac = platform "!windows & !darwin" $ testCase "Unix-like only" $ pure ()+--+-- -- On Linux or macOS but not Windows+-- test_unixLike :: TestTree+-- test_unixLike = platform "(linux | darwin) & !windows" $ testCase "Unix-like" $ pure ()+-- @+platform :: String -> TT.TestTree -> TT.TestTree+platform expr testTree = +  if evaluatePlatformExpression expr os+    then testTree+    else skip testTree++-- | Evaluate a platform expression against a given platform string.+--+-- Inputs:+-- - The first argument is the platform expression (e.g. @"linux | darwin"@, @"!windows"@).+-- - The second argument is the current platform, typically @System.Info.os@ (e.g. @"linux"@, @"darwin"@, @"mingw32"@).+--+-- Semantics (result is 'True' when the test should run):+-- - Supported platform names: @"linux"@, @"darwin"@, @"mingw32"@, @"windows"@ (alias for @"mingw32"@), and @"unix"@ (alias for @"linux | darwin"@).+-- - Supported operators: NOT @!@, AND @&@, OR @|@.+-- - Unknown simple names evaluate to 'False' (do not run).+-- - Malformed or empty expressions evaluate to 'True' (default to running).+--   Malformed includes the presence of operator characters without a valid parse.+-- - Parentheses characters @(@ and @)@ are tokenized but grouping is not currently implemented;+--   using parentheses in the expression will cause it to be treated as malformed and therefore+--   default to 'True' (run). Prefer composing with @&@ and @|@ without parentheses.+--+-- Examples:+--+-- @+-- evaluatePlatformExpression "linux"        "linux"   == True+-- evaluatePlatformExpression "linux"        "darwin"  == False+-- evaluatePlatformExpression "!windows"     "mingw32" == False+-- evaluatePlatformExpression "linux|darwin" "darwin"  == True+-- evaluatePlatformExpression "unix"         "darwin"  == True   -- alias for linux|darwin+-- evaluatePlatformExpression "unknown"      "linux"   == False  -- unknown simple name+-- evaluatePlatformExpression ""             "linux"   == True   -- empty -> run+-- @+evaluatePlatformExpression :: String -> String -> Bool+evaluatePlatformExpression expr currentPlatform = +  case parsePlatformExpression expr of+    Just result -> evalExpression result currentPlatform+    Nothing -> +      -- If it's just a simple unknown platform name, return False+      -- If it's an empty/malformed expression, return True+      let malformedOrEmpty = null (words expr) || any (`elem` ['&', '|', '!', '(', ')']) expr+      in malformedOrEmpty++-- Parse a platform expression with logical operators+parsePlatformExpression :: String -> Maybe PlatformExpr+parsePlatformExpression expr = parseOr (tokenize expr)++-- Tokenize the expression preserving logical operators+tokenize :: String -> [String]+tokenize = words . concatMap tokenizeChar+  where+    tokenizeChar '&' = " & "+    tokenizeChar '|' = " | "  +    tokenizeChar '(' = " ( "+    tokenizeChar ')' = " ) "+    tokenizeChar c = [c]++-- Parse OR expressions (lowest precedence)+parseOr :: [String] -> Maybe PlatformExpr+parseOr tokens = case break (== "|") tokens of+  (left, []) -> parseAnd left+  (left, _:right) -> do+    leftExpr <- parseAnd left+    rightExpr <- parseOr right+    return $ Or leftExpr rightExpr++-- Parse AND expressions (higher precedence)+parseAnd :: [String] -> Maybe PlatformExpr+parseAnd tokens = case break (== "&") tokens of+  (left, []) -> parseAtom left+  (left, _:right) -> do+    leftExpr <- parseAtom left+    rightExpr <- parseAnd right+    return $ And leftExpr rightExpr++-- Parse atomic expressions (platform names and negation)+parseAtom :: [String] -> Maybe PlatformExpr+parseAtom [] = Nothing+parseAtom tokens = case tokens of+  ["linux"] -> Just $ PlatformName "linux"+  ["darwin"] -> Just $ PlatformName "darwin"+  ["windows"] -> Just $ PlatformName "mingw32"+  ["mingw32"] -> Just $ PlatformName "mingw32"+  ["unix"] -> Just $ Or (PlatformName "linux") (PlatformName "darwin")+  ["!linux"] -> Just $ Not (PlatformName "linux")+  ["!darwin"] -> Just $ Not (PlatformName "darwin")+  ["!windows"] -> Just $ Not (PlatformName "mingw32")+  ["!mingw32"] -> Just $ Not (PlatformName "mingw32")+  ["!unix"] -> Just $ Not (Or (PlatformName "linux") (PlatformName "darwin"))+  _ -> Nothing++-- Simple expression data type+data PlatformExpr +  = PlatformName String+  | Not PlatformExpr+  | And PlatformExpr PlatformExpr  +  | Or PlatformExpr PlatformExpr+  deriving stock (Show, Eq)++-- Evaluate the expression against the current platform+evalExpression :: PlatformExpr -> String -> Bool+evalExpression expr currentPlatform = case expr of+  PlatformName platformName -> currentPlatform == platformName+  Not e -> not (evalExpression e currentPlatform)+  And e1 e2 -> evalExpression e1 currentPlatform && evalExpression e2 currentPlatform+  Or e1 e2 -> evalExpression e1 currentPlatform || evalExpression e2 currentPlatform
src/Test/Tasty/Discover/Internal/Config.hs view
@@ -7,6 +7,13 @@   ( -- * Configuration Options     Config (..)   , GlobPattern+  , SkipTest (..)+  , OnPlatform (..)+  , checkPlatform+  , onLinux+  , onDarwin  +  , onWindows+  , onUnix      -- * Configuration Parser   , parseConfig@@ -16,8 +23,11 @@   ) where  import Data.Maybe            (isJust)+import GHC.Generics          (Generic) import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), ArgOrder (Permute), OptDescr (Option), getOpt') import System.FilePath ((</>))+import System.Info (os)+import Test.Tasty.Options (IsOption (..), safeRead)  -- | A tasty ingredient. type Ingredient = String@@ -25,6 +35,79 @@ -- | A glob pattern. type GlobPattern = String +-- | Newtype wrapper for skip test option.+--+-- This option type integrates with Tasty's option system to control whether+-- tests should be skipped. When set to @SkipTest True@, tests will show as+-- @[SKIPPED]@ in yellow in the test output and won't actually execute.+--+-- Used internally by the 'skip' function and 'Flavored' type to implement+-- test skipping functionality.+newtype SkipTest = SkipTest Bool+  deriving stock (Show, Eq, Generic)++instance IsOption SkipTest where+  defaultValue = SkipTest False+  parseValue = fmap SkipTest . safeRead+  optionName = return "skip-test"+  optionHelp = return "Skip test execution (useful for debugging test discovery)"++-- | Newtype wrapper for platform-specific test filtering.+--+-- This option type allows tests to be conditionally executed based on platform+-- criteria. The wrapped function takes a platform string and returns whether+-- the test should run on that platform.+--+-- Platform values correspond to System.Info.os:+-- - "linux" for Linux systems+-- - "darwin" for macOS+-- - "mingw32" for Windows (GHC compiled)+-- - "unix" matches both "linux" and "darwin"+--+-- Example usage:+-- @+-- -- Only run on Linux+-- onLinux :: OnPlatform  +-- onLinux = OnPlatform (== "linux")+--+-- -- Run on Unix-like systems+-- onUnix :: OnPlatform+-- onUnix = OnPlatform (\p -> p `elem` ["linux", "darwin"])+-- @+newtype OnPlatform = OnPlatform (String -> Bool)++instance IsOption OnPlatform where+  defaultValue = OnPlatform (const True)  -- Run on all platforms by default+  parseValue s = case s of+    "linux"   -> Just $ OnPlatform (== "linux")+    "darwin"  -> Just $ OnPlatform (== "darwin") +    "mingw32" -> Just $ OnPlatform (== "mingw32")  -- Windows with GHC+    "windows" -> Just $ OnPlatform (== "mingw32")  -- Alias for mingw32+    "unix"    -> Just $ OnPlatform (\p -> p `elem` ["linux", "darwin"])+    _         -> Nothing+  optionName = return "on-platform"+  optionHelp = return "Run test only on specified platform (linux|darwin|mingw32|windows|unix)"++-- | Check if the current platform matches the OnPlatform criteria+checkPlatform :: OnPlatform -> Bool+checkPlatform (OnPlatform f) = f os++-- | Helper function: only run on Linux+onLinux :: OnPlatform+onLinux = OnPlatform (== "linux")++-- | Helper function: only run on macOS+onDarwin :: OnPlatform+onDarwin = OnPlatform (== "darwin")++-- | Helper function: only run on Windows (mingw32)+onWindows :: OnPlatform  +onWindows = OnPlatform (== "mingw32")++-- | Helper function: only run on Unix-like systems (Linux or macOS)+onUnix :: OnPlatform+onUnix = OnPlatform (\p -> p `elem` ["linux", "darwin"])+ -- | The discovery and runner configuration. data Config = Config   { modules             :: Maybe GlobPattern -- ^ Glob pattern for matching modules during test discovery.@@ -39,11 +122,12 @@   , noModuleSuffix      :: Bool              -- ^ <<<DEPRECATED>>>: suffix and look in all modules.   , debug               :: Bool              -- ^ Debug the generated module.   , treeDisplay         :: Bool              -- ^ Tree display for the test results table.-  } deriving (Show)+  , noMain              :: Bool              -- ^ Whether to generate main function.+  } deriving stock (Show, Generic)  -- | The default configuration defaultConfig :: FilePath -> Config-defaultConfig theSearchDir = Config Nothing Nothing theSearchDir Nothing Nothing [] [] [] False False False False+defaultConfig theSearchDir = Config Nothing Nothing theSearchDir Nothing Nothing [] [] [] False False False False False  -- | Deprecation message for old `--[no-]module-suffix` option. moduleSuffixDeprecationMessage :: String@@ -115,4 +199,7 @@   , Option [] ["tree-display"]       (NoArg $ \c -> c {treeDisplay = True})       "Display test output hierarchically"+  , Option [] ["no-main"]+      (NoArg $ \c -> c {noMain = True})+      "Do not generate a main function"   ]
src/Test/Tasty/Discover/Internal/Driver.hs view
@@ -10,10 +10,13 @@   , findTests   , mkModuleTree   , showTests+  , extractTests   ) where +import Control.Monad                          (filterM) import Data.List                              (dropWhileEnd, intercalate, isPrefixOf, nub, sort, stripPrefix) import Data.Maybe                             (fromMaybe)+import System.Directory                       (doesFileExist) import System.FilePath                        (pathSeparator) import System.FilePath.Glob                   (compile, globDir1, match) import System.IO                              (IOMode (ReadMode), withFile)@@ -30,14 +33,6 @@ 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@@ -46,13 +41,31 @@       testNumVars = map (("t"++) . show) [(0 :: Int)..]       testKindImports = map generatorImports generators' :: [[String]]       testImports = showImports (map ingredientImport is ++ map testModule tests) :: [String]+      exports = if noMain config+                then "(ingredients, tests)"+                else "(main, ingredients, tests)"+      mainFunction = if noMain config+                     then ""+                     else concat [ "main :: IO ()\n"+                                 , "main = do\n"+                                 , "  args <- E.getArgs\n"+                                 , "  E.withArgs (" ++ show (tastyOptions config) ++ " ++ args) $"+                                 , "    tests >>= T.defaultMainWithIngredients ingredients\n"+                                 ]+      -- Only include System.Environment import when main function is generated+      envImport = if noMain config then [] else ["import qualified System.Environment as E"]+      baseImports = [ "import Prelude"+                    , "import qualified Test.Tasty as T"+                    , "import qualified Test.Tasty.Ingredients as T"+                    ] ++ envImport   in concat     [ "{-# LANGUAGE FlexibleInstances #-}\n"     , "\n"-    , "module " ++ modname ++ " (main, ingredients, tests) where\n"+    , "module " ++ modname ++ " " ++ exports ++ " where\n"     , "\n"-    , unlines $ nub $ sort $ mconcat (defaultImports:testKindImports) ++ testImports+    , unlines $ nub $ sort $ mconcat (baseImports:testKindImports) ++ testImports     , "\n"+    , "{- HLINT ignore \"Evaluate\" -}\n"     , "{- HLINT ignore \"Use let\" -}\n"     , "\n"     , unlines $ map generatorClass generators'@@ -64,17 +77,16 @@     , "]\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"+    , mainFunction     ]  -- | Match files by specified glob pattern. filesByModuleGlob :: FilePath -> Maybe GlobPattern -> IO [String]-filesByModuleGlob directory globPattern = globDir1 pattern directory-  where pattern = compile ("**/" ++ fromMaybe "*.hs*" globPattern)+filesByModuleGlob directory globPattern = do+  allPaths <- globDir1 pattern directory+  -- Filter out directories to avoid "inappropriate type" errors+  filterM doesFileExist allPaths+  where pattern = compile ("**/" ++ fromMaybe "*.hs" globPattern)  -- | Filter and remove files by specified glob pattern. ignoreByModuleGlob :: [FilePath] -> Maybe GlobPattern -> [FilePath]@@ -105,12 +117,35 @@  -- | Extract the test names from discovered modules. extractTests :: FilePath -> String -> [Test]-extractTests file = mkTestDeDuped . isKnownPrefix . parseTest-  where mkTestDeDuped = map (mkTest file) . nub+extractTests file content = mkTestDeDuped . isKnownPrefix . parseTest . preprocessHaskell $ content+  where mkTestDeDuped :: [String] -> [Test]+        mkTestDeDuped = map (mkTest file) . nub++        isKnownPrefix :: [String] -> [String]         isKnownPrefix = filter (\g -> any (checkPrefix g) generators)++        checkPrefix :: String -> Generator -> Bool         checkPrefix g = (`isPrefixOf` g) . generatorPrefix++        parseTest :: String -> [String]         parseTest     = map fst . concatMap lex . lines +-- | Preprocess Haskell source to remove block comments only+preprocessHaskell :: String -> String+preprocessHaskell = removeBlockComments++-- | Remove {- -} block comments (handles nesting)+removeBlockComments :: String -> String+removeBlockComments = go (0 :: Int)+  where+    go _ [] = []+    go depth ('{':'-':rest) = go (depth + 1) rest+    go depth ('-':'}':rest) +      | depth > 0 = go (depth - 1) rest+      | otherwise = '-' : '}' : go depth rest+    go 0 (c:rest) = c : go 0 rest+    go depth (_:rest) = go depth rest+ -- | Show the imports. showImports :: [String] -> [String] showImports mods = sort $ map ("import qualified " ++) mods@@ -130,7 +165,7 @@   else zipWith const testNumVars tests  newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String]))-  deriving (Eq, Show)+  deriving stock (Eq, Show)  showModuleTree :: ModuleTree -> [String] showModuleTree (ModuleTree mdls) = map showModule $ M.assocs mdls
src/Test/Tasty/Discover/Internal/Generator.hs view
@@ -25,13 +25,16 @@ import Data.Function   (on) import Data.List       (find, groupBy, isPrefixOf, sortOn) import Data.Maybe      (fromJust)+import GHC.Generics    (Generic) import System.FilePath (dropExtension, isPathSeparator) +import Test.Tasty.Discover.Internal.Unsafe (unsafeHead)+ -- | The test type. data Test = Test   { testModule   :: String -- ^ Module name.   , testFunction :: String -- ^ Function name.-  } deriving (Eq, Show, Ord)+  } deriving stock (Eq, Show, Generic, Ord)  -- | 'Test' constructor. mkTest :: FilePath -> String -> Test@@ -44,7 +47,7 @@   , generatorImports  :: [String]        -- ^ Module import path.   , generatorClass    :: String          -- ^ Generator class.   , generatorSetup    :: Test -> String  -- ^ Generator setup.-  }+  } deriving stock (Generic)  -- | Module import qualifier. qualifyFunction :: Test -> String@@ -52,7 +55,7 @@  -- | Function namer. name :: Test -> String-name = chooser '_' ' ' . tail . dropWhile (/= '_') . testFunction+name = chooser '_' ' ' . drop 1 . dropWhile (/= '_') . testFunction   where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3  -- | Generator retriever (single).@@ -61,9 +64,13 @@   where getPrefix = find ((`isPrefixOf` testFunction t) . generatorPrefix)  -- | Generator retriever (many).+--+-- Groups tests by generator prefix and extracts one representative generator+-- from each group. Uses 'unsafeHead' because 'groupBy' never produces empty+-- groups when given a non-empty input list. getGenerators :: [Test] -> [Generator] getGenerators =-  map head .+  map unsafeHead .   groupBy  ((==) `on` generatorPrefix) .   sortOn generatorPrefix .   map getGenerator@@ -89,9 +96,9 @@ hedgehogPropertyGenerator :: Generator hedgehogPropertyGenerator = Generator   { generatorPrefix   = "hprop_"-  , generatorImports  = ["import qualified Test.Tasty.Hedgehog as H"]+  , generatorImports  = ["import qualified Test.Tasty.Hedgehog as H", "import Data.String (fromString)"]   , generatorClass    = ""-  , generatorSetup    = \t -> "pure $ H.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t+  , generatorSetup    = \t -> "pure $ H.testPropertyNamed \"" ++ name t ++ "\" (fromString \"" ++ qualifyFunction t ++ "\") " ++ qualifyFunction t   }  -- | Quickcheck group generator prefix.
+ src/Test/Tasty/Discover/Internal/Unsafe.hs view
@@ -0,0 +1,37 @@+-- | Unsafe utility functions for internal use.+--+-- This module contains partial functions that are used internally+-- where we have strong invariants that guarantee they won't fail,+-- but we want to be explicit about their unsafe nature.++module Test.Tasty.Discover.Internal.Unsafe+  ( unsafeHead+  ) where++-- | Unsafe head function with descriptive error message.+-- +-- This function is partial and will throw an error on empty lists.+-- It should only be used when there's a strong invariant guaranteeing+-- the list is non-empty.+--+-- __Why use this instead of a total function?__+--+-- * Preserves existing type signatures and caller simplicity+-- * Makes invariant violations fail fast with clear error messages+-- * Avoids pushing complexity up the call chain for conditions that should never occur+-- * Used specifically in 'getGenerators' where 'groupBy' never produces empty groups+--+-- __When to use:__+--+-- * Internal functions with strong invariants+-- * Performance-critical code where the invariant is guaranteed+-- * When converting to total functions would complicate the entire call chain+--+-- __When NOT to use:__+--+-- * Public APIs where callers might pass invalid input+-- * When the input domain genuinely includes edge cases+-- * When safety is more important than performance+unsafeHead :: [a] -> a+unsafeHead []    = error "unsafeHead: empty list"+unsafeHead (x:_) = x
src/Test/Tasty/Discover/TastyInfo.hs view
@@ -3,11 +3,12 @@   ) where  import Data.Monoid+import GHC.Generics (Generic)  data TastyInfo = TastyInfo   { name        :: Last String   , description :: Last String-  } deriving (Eq, Show)+  } deriving stock (Eq, Show, Generic)  instance Semigroup TastyInfo where   a <> b = TastyInfo
tasty-discover.cabal view
@@ -1,7 +1,7 @@-cabal-version: 2.2+cabal-version: 3.0  name:                   tasty-discover-version:                4.2.4+version:                5.2.0 synopsis:               Test discovery for the tasty framework. description:            Automatic test discovery and runner for the tasty framework.                       @@ -21,10 +21,10 @@ author:                 Luke Murphy maintainer:             John Ky <newhoggy@gmail.com> copyright:              2016 Luke Murphy-                        2020-2021 John Ky+                        2020-2025 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+tested-with:            GHC == 9.12.2, GHC == 9.10.2, GHC == 9.8.4, GHC == 9.6.7 build-type:             Simple extra-source-files:     CHANGELOG.md                         README.md@@ -33,60 +33,83 @@   type: git   location: https://github.com/haskell-works/tasty-discover +flag dev+  description: Enable development mode+  manual: True+  default: False+ common base                       { build-depends: base                       >= 4.11       && < 5      } +common ansi-terminal              { build-depends: ansi-terminal              >= 1.0      && < 2.0      } 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.9      }-common hspec-core                 { build-depends: hspec-core                 >= 2.7.10   && < 2.11     }+common hspec                      { build-depends: hspec                      >= 2.7      && < 2.12     }+common hspec-core                 { build-depends: hspec-core                 >= 2.7.10   && < 2.12     } 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.1      && < 2.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      }+common tasty-expected-failure     { build-depends: tasty-expected-failure     >= 0.12     && < 0.13     }+common process                    { build-depends: process                    >= 1.6      && < 2.0      }+common temporary                  { build-depends: temporary                  >= 1.3      && < 1.4      } +common project-config+  default-extensions:   DeriveGeneric+                        DerivingStrategies+  if (impl(ghc >= 9.2.1))+    default-extensions: OverloadedRecordDot+  ghc-options:          -Wall+                        -Widentities+                        -Wincomplete-uni-patterns+                        -Wmissing-deriving-strategies+                        -Wredundant-constraints+                        -Wunused-packages+  default-language:     Haskell2010+  if (flag(dev))+    ghc-options:        -Werror++common tasty-discover+  build-depends: tasty-discover+ library+  import:               base, project-config+                      , ansi-terminal+                      , containers+                      , directory+                      , filepath+                      , Glob+                      , tasty   exposed-modules:      Test.Tasty.Discover                         Test.Tasty.Discover.Internal.Config                         Test.Tasty.Discover.Internal.Driver                         Test.Tasty.Discover.Internal.Generator+                        Test.Tasty.Discover.Internal.Unsafe                         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+executable tasty-discover+  import:               base, project-config                       , filepath-  main-is:              executable/Main.hs+  main-is:              app/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+  import:               base, project-config+                      , ansi-terminal                       , bytestring                       , containers                       , directory@@ -94,25 +117,47 @@                       , hedgehog                       , hspec                       , hspec-core+                      , process                       , tasty+                      , tasty-expected-failure                       , tasty-golden                       , tasty-hedgehog                       , tasty-hspec                       , tasty-hunit                       , tasty-quickcheck                       , tasty-smallcheck+                      , temporary   type:                 exitcode-stdio-1.0   main-is:              Driver.hs   ghc-options:          -threaded -rtsopts -with-rtsopts=-N-  other-modules:        ConfigTest+  other-modules:        BackupFiles.ValidTest+                        ConfigTest                         DiscoverTest+                        ModulesGlob.Sub.OneTest+                        ModulesGlob.TwoTest                         SubMod.FooBaz                         SubMod.PropTest                         SubMod.SubSubMod.PropTest-                        Paths_tasty_discover+  other-modules:        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++test-suite no-main-test+  import:               base, project-config+                      , tasty+                      , tasty-hunit+                      , tasty-quickcheck+  type:                 exitcode-stdio-1.0+  main-is:              Main.hs+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N+  other-modules:        Tests+                        Tests.Simple+  other-modules:        Paths_tasty_discover+  autogen-modules:      Paths_tasty_discover+  hs-source-dirs:       test-no-main   build-depends:        tasty-discover   default-language:     Haskell2010   build-tool-depends:   tasty-discover:tasty-discover
+ test-no-main/Main.hs view
@@ -0,0 +1,19 @@+module Main where++import qualified Tests+import qualified Test.Tasty as T++main :: IO ()+main = do+  putStrLn "=== No-Main Feature Test ==="+  putStrLn "This test demonstrates the --no-main option"+  putStrLn "where Tests module has no main function.\n"++  -- Get the discovered tests from the Tests module+  discoveredTests <- Tests.tests++  -- Apply a custom wrapper to demonstrate custom main functionality+  let wrappedTests = T.testGroup "Custom No-Main Wrapper" [discoveredTests]++  -- Run tests using ingredients from Tests module+  T.defaultMainWithIngredients Tests.ingredients wrappedTests
+ test-no-main/Tests.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --no-main -optF --generated-module -optF Tests -optF --in-place #-}+-- GENERATED BY tasty-discover+{-# LANGUAGE FlexibleInstances #-}++module Tests (ingredients, tests) where++import Prelude+import qualified Test.Tasty as T+import qualified Test.Tasty.Discover as TD+import qualified Test.Tasty.HUnit as HU+import qualified Test.Tasty.Ingredients as T+import qualified Test.Tasty.QuickCheck as QC+import qualified Tests.Simple++{- HLINT ignore "Evaluate" -}+{- HLINT ignore "Use let" -}++++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 <- testCase "simpleTest" Tests.Simple.unit_simpleTest++  t1 <- pure $ QC.testProperty "alwaysTrue" Tests.Simple.prop_alwaysTrue++  t2 <- TD.tasty (TD.description "customGroup" <> TD.name "Tests.Simple.tasty_customGroup") Tests.Simple.tasty_customGroup++  pure $ T.testGroup "test-no-main/Tests.hs" [t0,t1,t2]+ingredients :: [T.Ingredient]+ingredients = T.defaultIngredients+
+ test-no-main/Tests/Simple.hs view
@@ -0,0 +1,17 @@+module Tests.Simple where++import qualified Test.Tasty as T+import qualified Test.Tasty.HUnit as HU++-- Simple test cases for the no-main feature demo+unit_simpleTest :: IO ()+unit_simpleTest = pure ()++prop_alwaysTrue :: Bool -> Bool+prop_alwaysTrue _ = True++tasty_customGroup :: T.TestTree+tasty_customGroup = T.testGroup "Custom Test Group"+  [ HU.testCase "custom test 1" $ return ()+  , HU.testCase "custom test 2" $ (1 + 1 :: Int) HU.@?= 2+  ]
+ test/BackupFiles/ValidTest.hs view
@@ -0,0 +1,8 @@+module BackupFiles.ValidTest where++-- This module is part of the regression test for spec_backupFilesIgnored+-- in ConfigTest.hs. The accompanying .hs.orig and .hs.bak files test+-- that tasty-discover only processes .hs files and ignores backup files.++prop_validTest :: Bool -> Bool+prop_validTest _ = True
test/ConfigTest.hs view
@@ -5,19 +5,32 @@  module ConfigTest where -import Data.List                              (isInfixOf, sort)+import Data.List                              (isInfixOf, isSuffixOf, sort)+import System.Console.ANSI                    (Color(..), ColorIntensity(..), ConsoleLayer(..), SGR(..), setSGRCode) import Test.Tasty.Discover.Internal.Config-import Test.Tasty.Discover.Internal.Driver    (ModuleTree (..), findTests, generateTestDriver, mkModuleTree, showTests)+import Test.Tasty.Discover.Internal.Driver    (ModuleTree (..), findTests, generateTestDriver, mkModuleTree, showTests, extractTests) import Test.Tasty.Discover.Internal.Generator (Test (..), mkTest) -import Test.Tasty.HUnit+import Test.Tasty.HUnit hiding (Assertion) import Test.Tasty.QuickCheck import Test.Hspec.Core.Spec (Spec, describe, it)  import Test.Hspec (shouldBe, shouldSatisfy)+import Test.Tasty.ExpectedFailure (expectFail)+import qualified Test.Tasty as T+import qualified Test.Tasty.HUnit as HU+import qualified Test.Tasty.Discover as TD  import qualified Data.Map.Strict as M +-- For symlinks test+import System.Directory (createDirectoryIfMissing, createFileLink,+                        doesDirectoryExist, listDirectory)+import System.FilePath ((</>))+import System.Process (readProcessWithExitCode)+import System.IO.Temp (withSystemTempDirectory)+import System.Exit (ExitCode(..))+ spec_modules :: Spec spec_modules = describe "Test discovery" $ do   it "Discovers tests" $ do@@ -42,6 +55,29 @@     discoveredTests <- findTests badGlobConfig     discoveredTests `shouldBe` [] +spec_backupFilesIgnored :: Spec+spec_backupFilesIgnored = describe "Backup file filtering" $ do+  it "Only matches .hs files, not backup files containing .hs" $ do+    let config = defaultConfig "test/BackupFiles"+    discoveredTests <- findTests config+    -- Should only find ValidTest.hs, not ValidTest.hs.orig or ValidTest.hs.bak+    let moduleNames = map testModule discoveredTests+    length discoveredTests `shouldBe` 1+    moduleNames `shouldBe` ["ValidTest"]+    -- Verify no backup file patterns were found+    let hasBackupPattern name = ".hs." `isInfixOf` name || ".hs" `isInfixOf` name && not (".hs" `isSuffixOf` name)+    moduleNames `shouldSatisfy` (not . any hasBackupPattern)++spec_modulesGlobIgnoresDirectories :: Spec+spec_modulesGlobIgnoresDirectories = describe "Modules glob directory handling" $ do+  it "Ignores directories that match the glob pattern" $ do+    let config = (defaultConfig "test/ModulesGlob") { modules = Just "*" }+    discoveredTests <- findTests config+    -- Should find both test files, not fail on the Sub directory+    let moduleNames = sort $ map testModule discoveredTests+    length discoveredTests `shouldBe` 2+    moduleNames `shouldBe` ["Sub.OneTest", "TwoTest"]+ spec_customModuleName :: Spec spec_customModuleName = describe "Module name configuration" $ do   it "Creates a generated main function with the specified name" $ do@@ -83,3 +119,257 @@               else resize (size `div` 2) arbitrary             tVars <- listOf1 (listOf1 arbitrary)             pure (mdl, (subTree, tVars))++spec_commentHandling :: Spec+spec_commentHandling = describe "Comment handling" $ do+  it "ignores tests in block comments" $ do+    let content = unlines+          [ "module Test where"+          , "{- block comment"+          , "test_ignored :: TestTree"+          , "test_ignored = testCase \"ignored\" $ pure ()"+          , "-}"+          , "test_valid :: TestTree"+          , "test_valid = testCase \"valid\" $ pure ()"+          ]+    let tests = extractTests "Test.hs" content+        testNames = map testFunction tests+    testNames `shouldBe` ["test_valid"]++  it "ignores tests in nested block comments" $ do+    let content = unlines+          [ "module Test where"+          , "{- outer comment"+          , "test_outerIgnored :: TestTree"+          , "  {- inner comment"+          , "test_innerIgnored :: TestTree"+          , "  -}"+          , "test_stillOuterIgnored :: TestTree"+          , "-}"+          , "test_valid :: TestTree"+          ]+    let tests = extractTests "Test.hs" content+        testNames = map testFunction tests+    testNames `shouldBe` ["test_valid"]++  it "correctly handles line comments (existing behavior)" $ do+    let content = unlines+          [ "module Test where"+          , "-- test_lineIgnored :: TestTree"+          , "-- test_lineIgnored = testCase \"ignored\" $ pure ()"+          , "test_valid :: TestTree"+          , "test_valid = testCase \"valid\" $ pure ()"+          ]+    let tests = extractTests "Test.hs" content+        testNames = map testFunction tests+    testNames `shouldBe` ["test_valid"]++  it "finds multiple valid tests correctly" $ do+    let content = unlines+          [ "module Test where"+          , "test_first :: TestTree"+          , "{-"+          , "test_ignored :: TestTree"+          , "-}"+          , "test_second :: TestTree"+          , "test_third :: TestTree"+          ]+    let tests = extractTests "Test.hs" content+        testNames = sort $ map testFunction tests+    testNames `shouldBe` sort ["test_first", "test_second", "test_third"]++{- |+= Custom Test Type Wrapping Pattern++This module demonstrates how to create custom test type wrappers using the @newtype@ pattern+to integrate external testing libraries with tasty-discover's @Tasty@ typeclass and provide+ergonomic flavor functionality (such as skipping tests).++== The Pattern++1. **Wrap external test types**: Use @newtype@ to wrap test types from other libraries+   (e.g., HUnit's @Assertion@, QuickCheck's @Property@, etc.)++2. **Implement Tasty instance**: Provide a @Tasty@ instance that handles the @SkipTest@ option+   and other flavor transformations++3. **Ergonomic skipping**: Tests can be easily skipped using the @Flavored@ pattern with+   visual feedback (yellow @[SKIPPED]@ text)++== Benefits++- **Library Integration**: Seamlessly integrate any testing library with tasty-discover+- **Consistent Interface**: All test types get the same flavor functionality (skip, platform, etc.)+- **Visual Feedback**: Skipped tests are clearly marked with colored @[SKIPPED]@ indicators+- **Type Safety**: @newtype@ provides zero-cost abstractions with compile-time guarantees++== Example Implementation++The @Assertion@ newtype below demonstrates this pattern:++@+newtype Assertion = Assertion HU.Assertion++instance TD.Tasty Assertion where+  tasty info (Assertion assertion) = do+    let yellowText text = setSGRCode [SetColor Foreground Vivid Yellow] ++ text ++ setSGRCode [Reset]+    return $ T.askOption $ \\(TD.SkipTest shouldSkip) ->+      if shouldSkip+        then HU.testCase (TD.nameOf info ++ " " ++ yellowText "[SKIPPED]") (pure ())+        else HU.testCase (TD.nameOf info) assertion+@++== Usage Patterns++**Basic test:**+@+tasty_myTest :: Assertion+tasty_myTest = Assertion $ do+  result <- someComputation+  result \@?\= expectedValue+@++**Skipped test:**+@+tasty_skippedTest :: TD.Flavored Assertion+tasty_skippedTest = TD.flavored TD.skip $ Assertion $ do+  -- This will show as [SKIPPED] in yellow and won't execute+  error "This never runs"+@++**Platform-conditional test:**+@+tasty_linuxOnly :: TD.Flavored Assertion+tasty_linuxOnly = TD.flavored (TD.platform "linux") $ Assertion $ do+  -- Only runs on Linux systems+  linuxSpecificAssertion+@++== Integration with Other Libraries++This pattern can be applied to any testing library:++- **Hedgehog**: @newtype Property = Property H.Property@+- **QuickCheck**: @newtype QCProperty = QCProperty QC.Property@+- **Hspec**: @newtype SpecTest = SpecTest Spec@+- **Custom frameworks**: @newtype MyTest = MyTest MyLibrary.Test@++Each wrapper can implement the @Tasty@ instance to provide consistent flavor functionality+across all test types in your project.+-}++-- | Custom Assertion newtype that wraps HU.Assertion+--+-- This demonstrates the newtype wrapping pattern for integrating external test types+-- with tasty-discover's Tasty typeclass and flavor functionality.+newtype Assertion = Assertion HU.Assertion++-- | Tasty instance for Assertion that provides SkipTest support+--+-- Key features:+-- * Checks SkipTest option at runtime using askOption+-- * Renders skipped tests with yellow [SKIPPED] indicator+-- * Falls back to normal HUnit test execution when not skipped+-- * Maintains test name consistency through TD.nameOf+instance TD.Tasty Assertion where+  tasty info (Assertion assertion) = do+    let yellowText text = setSGRCode [SetColor Foreground Vivid Yellow] ++ text ++ setSGRCode [Reset]+    return $ T.askOption $ \(TD.SkipTest shouldSkip) ->+      if shouldSkip+        then HU.testCase (TD.nameOf info ++ " " ++ yellowText "[SKIPPED]") (pure ())+        else HU.testCase (TD.nameOf info) assertion++-- | Example: Basic usage of the Assertion newtype+--+-- Shows how to create a simple test using the wrapped type.+-- The test will execute normally unless skipped via flavoring.+tasty_assertionExample :: Assertion+tasty_assertionExample = Assertion $ do+  let result = 2 + 2 :: Int+  result @?= 4++-- | Example: Skipped test using Flavored pattern+--+-- Demonstrates how the newtype integrates with the Flavored mechanism+-- to provide ergonomic test skipping with visual feedback.+tasty_skippedAssertion :: TD.Flavored Assertion+tasty_skippedAssertion = TD.flavored TD.skip $ Assertion $ do+  -- This test will be skipped and show "[SKIPPED]" in yellow+  error "This should never run because the test is skipped"++-- | Example: Platform-conditional test+--+-- Shows how the same newtype can work with platform filtering,+-- demonstrating the composability of flavor transformations.+tasty_platformAssertion :: TD.Flavored Assertion+tasty_platformAssertion = TD.flavored (TD.platform "!windows") $ Assertion $ do+  -- This test only runs on non-Windows platforms+  let unixSpecificResult = "Unix-style path" :: String+  length unixSpecificResult @?= 15++spec_symlinksNotFollowed :: Spec+spec_symlinksNotFollowed = describe "Symlinks handling" $ do+  it "this test is disabled - see tasty_symlinksNotFollowed instead" $ do+    pure () :: IO ()++-- Tasty test that expects failure for symlink handling+tasty_symlinksNotFollowed :: IO T.TestTree+tasty_symlinksNotFollowed = do+  pure $ expectFail $ HU.testCase "should handle symlinked directories gracefully without crashing" $ do+    withSystemTempDirectory "tasty-discover-symlink-test" $ \tmpDir -> do+      -- Create a real test directory with a test file+      let realTestDir = tmpDir </> "real-tests"+      createDirectoryIfMissing True realTestDir+      writeFile (realTestDir </> "RealTest.hs") $ unlines+        [ "module RealTest where"+        , "import Test.Tasty.HUnit"+        , "test_real :: TestTree"+        , "test_real = testCase \"real test\" $ 1 @?= 1"+        ]++      -- Create a symlinked directory pointing to the real test directory+      let symlinkTestDir = tmpDir </> "symlinked-tests"+      createFileLink realTestDir symlinkTestDir++      -- Verify symlink was created+      symlinkExists <- doesDirectoryExist symlinkTestDir+      symlinkExists `shouldBe` True++      -- Helper function to print directory structure for debugging+      let printDirStructure dir prefix = do+            contents <- listDirectory dir+            mapM_ (\item -> do+              let fullPath = dir </> item+              isDir <- doesDirectoryExist fullPath+              if isDir+                then do+                  putStrLn $ prefix ++ item ++ "/ (directory)"+                  printDirStructure fullPath (prefix ++ "  ")+                else putStrLn $ prefix ++ item+              ) contents++      -- Run tasty-discover on the temp directory+      let outputFile = tmpDir </> "TestOutput.hs"+      (exitCode, _stdout, stderr) <- readProcessWithExitCode "tasty-discover" [tmpDir, "--output", outputFile] ""++      -- tasty-discover should NOT crash on symlinked directories+      -- This test will FAIL until issue #38 is fixed, which is the correct behavior+      case exitCode of+        ExitFailure code -> do+          putStrLn $ "tasty-discover crashed with exit code " ++ show code+          putStrLn $ "Test directory structure in " ++ tmpDir ++ ":"+          printDirStructure tmpDir ""+          putStrLn $ "stderr: " ++ stderr+          if "withFile: inappropriate type (is a directory)" `isInfixOf` stderr+            then error "BUG: tasty-discover crashes on symlinked directories (GitHub issue #38). This test will pass when the issue is fixed."+            else error $ "tasty-discover failed for unexpected reason: " ++ stderr+        ExitSuccess -> do+          -- Success! tasty-discover handled symlinks gracefully+          putStrLn "tasty-discover handled symlinks gracefully!"+          testOutput <- readFile outputFile+          -- Verify that at least the real test was found+          testOutput `shouldSatisfy` ("RealTest" `isInfixOf`)+          -- The behavior when symlinks are handled correctly could be:+          -- 1. Symlinks are followed (tests appear twice)+          -- 2. Symlinks are ignored (tests appear once)+          -- Either is acceptable as long as no crash occurs
test/DiscoverTest.hs view
@@ -1,16 +1,22 @@ {-# LANGUAGE CPP                 #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-} +{- HLINT ignore "Avoid reverse" -}+{- HLINT ignore "Redundant reverse" -}+ module DiscoverTest where  import Data.ByteString.Lazy (ByteString) import Data.List+import Data.Maybe (listToMaybe) import Data.String (IsString(..))+import GHC.Generics (Generic)+import System.Console.ANSI (Color(..), ColorIntensity(..), ConsoleLayer(..), SGR(..), setSGRCode) import Test.Hspec (shouldBe) import Test.Hspec.Core.Spec (Spec, describe, it) import Test.Tasty+import Test.Tasty.Discover (Flavored, flavored, skip, platform, applySkips, evaluatePlatformExpression) import Test.Tasty.Golden import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (Property, property)@@ -18,8 +24,10 @@ import qualified Hedgehog            as H import qualified Hedgehog.Gen        as G import qualified Hedgehog.Range      as R+import qualified Test.Tasty          as TT import qualified Test.Tasty.Discover as TD import qualified Test.Tasty.Hedgehog as TH+import qualified Test.Tasty.HUnit    as HU  ------------------------------------------------------------------------------------------------ @@ -41,7 +49,7 @@ spec_prelude :: Spec spec_prelude = describe "Prelude.head" $ do   it "returns the first element of a list" $ do-    head [23 ..] `shouldBe` (23 :: Int)+    listToMaybe [23 ..] `shouldBe` Just (23 :: Int)  ------------------------------------------------------------------------------------------------ @@ -69,33 +77,321 @@ test_generateTrees = pure (map (\s -> testCase s $ pure ()) ["First input", "Second input"])  --------------------------------------------------------------------------------------------------- How to add custom support for hedgehog to avoid deprecation warning from tasty-hedgehog+-- 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 $+  tasty info (Property p) = do+    let name = TD.nameOf info+    let mkTestTree = #if MIN_VERSION_tasty_hedgehog(1, 2, 0)-    TH.testPropertyNamed (TD.nameOf info) (fromString (TD.descriptionOf info)) p+          TH.testPropertyNamed name (fromString (TD.descriptionOf info)) #else-    TH.testProperty (TD.nameOf info) p+          TH.testProperty name #endif+        yellowText text = setSGRCode [SetColor Foreground Vivid Yellow] ++ text ++ setSGRCode [Reset]+    -- Apply skip functionality if SkipTest option is True+    pure $ askOption $ \(TD.SkipTest shouldSkip) ->+      if shouldSkip+        then testCase (TD.nameOf info ++ " " ++ yellowText "[SKIPPED]") (pure ())+        else mkTestTree p  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 +tasty_skip_me :: Flavored Property+tasty_skip_me =+  flavored skip $ property $ do+    H.failure++-- Skipping guideline (read this first):+--   To skip a tasty_ test at the TestTree level (so it shows [SKIPPED] and+--   doesn’t run), use:  flavored skip $ ...+--   Applying skip directly to a TestTree won’t skip it at that outer level; the+--   test itself must check SkipTest via askOption.+--+-- Implementation details (for the curious):+--   Applying skip to an already-constructed TestTree sets a Tasty option on the+--   subtree. The test body can observe it (as asserted below), but the Tasty+--   instance used by tasty_ functions may have already decided how to wrap the+--   node, so you won’t see a top-level [SKIPPED] placeholder. Wrapping with+--   flavored skip applies the transformation earlier, letting the instance see+--   SkipTest and short-circuit with a skipped placeholder.+tasty_tree_of_testCase_not_skipped :: TT.TestTree+tasty_tree_of_testCase_not_skipped =+  skip $ askOption $ \(TD.SkipTest shouldSkip) ->+    HU.testCase "This test is not skipped at the TestTree level" $+      HU.assertBool "Expected SkipTest to be True inside TestTree" shouldSkip+ --------------------------------------------------------------------------------------------------- How to use tasty-hedgehog up to version 1.1+-- Platform expression tests -{- HLINT ignore "Avoid reverse" -}+-- Test basic platform matching+unit_platformExpression_linux :: Assertion  +unit_platformExpression_linux =+  evaluatePlatformExpression "linux" "linux" @?= True++unit_platformExpression_darwin :: Assertion+unit_platformExpression_darwin =+  evaluatePlatformExpression "darwin" "darwin" @?= True++unit_platformExpression_windows :: Assertion+unit_platformExpression_windows =+  evaluatePlatformExpression "windows" "mingw32" @?= True++unit_platformExpression_mingw32 :: Assertion+unit_platformExpression_mingw32 =+  evaluatePlatformExpression "mingw32" "mingw32" @?= True++-- Test negation+unit_platformExpression_not_linux :: Assertion+unit_platformExpression_not_linux =+  evaluatePlatformExpression "!linux" "darwin" @?= True++unit_platformExpression_not_linux_false :: Assertion+unit_platformExpression_not_linux_false =+  evaluatePlatformExpression "!linux" "linux" @?= False++unit_platformExpression_not_darwin :: Assertion+unit_platformExpression_not_darwin =+  evaluatePlatformExpression "!darwin" "linux" @?= True++unit_platformExpression_not_darwin_false :: Assertion+unit_platformExpression_not_darwin_false =+  evaluatePlatformExpression "!darwin" "darwin" @?= False++unit_platformExpression_not_windows :: Assertion+unit_platformExpression_not_windows =+  evaluatePlatformExpression "!windows" "linux" @?= True++unit_platformExpression_not_windows_false :: Assertion+unit_platformExpression_not_windows_false =+  evaluatePlatformExpression "!windows" "mingw32" @?= False++unit_platformExpression_not_mingw32 :: Assertion+unit_platformExpression_not_mingw32 =+  evaluatePlatformExpression "!mingw32" "linux" @?= True++unit_platformExpression_not_mingw32_false :: Assertion+unit_platformExpression_not_mingw32_false =+  evaluatePlatformExpression "!mingw32" "mingw32" @?= False++unit_platformExpression_not_unix :: Assertion+unit_platformExpression_not_unix =+  evaluatePlatformExpression "!unix" "mingw32" @?= True++unit_platformExpression_not_unix_false_linux :: Assertion+unit_platformExpression_not_unix_false_linux =+  evaluatePlatformExpression "!unix" "linux" @?= False++unit_platformExpression_not_unix_false_darwin :: Assertion+unit_platformExpression_not_unix_false_darwin =+  evaluatePlatformExpression "!unix" "darwin" @?= False++-- Test conjunction (AND)+unit_platformExpression_and_true :: Assertion+unit_platformExpression_and_true =+  evaluatePlatformExpression "!windows & !darwin" "linux" @?= True++unit_platformExpression_and_false :: Assertion+unit_platformExpression_and_false =+  evaluatePlatformExpression "!windows & !darwin" "darwin" @?= False++unit_platformExpression_and_false_windows :: Assertion+unit_platformExpression_and_false_windows =+  evaluatePlatformExpression "!windows & !darwin" "mingw32" @?= False++unit_platformExpression_and_both_positive :: Assertion+unit_platformExpression_and_both_positive =+  evaluatePlatformExpression "unix & !windows" "linux" @?= True++unit_platformExpression_and_both_positive_false :: Assertion+unit_platformExpression_and_both_positive_false =+  evaluatePlatformExpression "unix & !windows" "mingw32" @?= False++unit_platformExpression_and_three_terms :: Assertion+unit_platformExpression_and_three_terms =+  evaluatePlatformExpression "!windows & !darwin & !mingw32" "linux" @?= True++-- Test disjunction (OR)+unit_platformExpression_or_true :: Assertion+unit_platformExpression_or_true =+  evaluatePlatformExpression "linux | darwin" "linux" @?= True++unit_platformExpression_or_true_darwin :: Assertion+unit_platformExpression_or_true_darwin =+  evaluatePlatformExpression "linux | darwin" "darwin" @?= True++unit_platformExpression_or_false :: Assertion+unit_platformExpression_or_false =+  evaluatePlatformExpression "linux | darwin" "mingw32" @?= False++unit_platformExpression_or_windows_mingw32 :: Assertion+unit_platformExpression_or_windows_mingw32 =+  evaluatePlatformExpression "windows | linux" "mingw32" @?= True++unit_platformExpression_or_three_platforms :: Assertion+unit_platformExpression_or_three_platforms =+  evaluatePlatformExpression "linux | darwin | windows" "darwin" @?= True++-- Test unix special case+unit_platformExpression_unix_linux :: Assertion+unit_platformExpression_unix_linux =+  evaluatePlatformExpression "unix" "linux" @?= True++unit_platformExpression_unix_darwin :: Assertion+unit_platformExpression_unix_darwin =+  evaluatePlatformExpression "unix" "darwin" @?= True++unit_platformExpression_unix_windows :: Assertion+unit_platformExpression_unix_windows =+  evaluatePlatformExpression "unix" "mingw32" @?= False++-- Test complex expressions+unit_platformExpression_complex1 :: Assertion+unit_platformExpression_complex1 =+  evaluatePlatformExpression "!windows & !darwin" "linux" @?= True++unit_platformExpression_complex2 :: Assertion  +unit_platformExpression_complex2 =+  evaluatePlatformExpression "linux | darwin" "freebsd" @?= False++-- Test edge cases+unit_platformExpression_unknown :: Assertion+unit_platformExpression_unknown =+  evaluatePlatformExpression "unknown_platform" "linux" @?= False++unit_platformExpression_empty :: Assertion+unit_platformExpression_empty =+  evaluatePlatformExpression "" "linux" @?= True  -- Should default to True on parse failure++unit_platformExpression_unknown_current :: Assertion+unit_platformExpression_unknown_current =+  evaluatePlatformExpression "linux" "freebsd" @?= False++unit_platformExpression_unix_freebsd :: Assertion+unit_platformExpression_unix_freebsd =+  evaluatePlatformExpression "unix" "freebsd" @?= False  -- unix only matches linux and darwin++unit_platformExpression_not_unix_freebsd :: Assertion+unit_platformExpression_not_unix_freebsd =+  evaluatePlatformExpression "!unix" "freebsd" @?= True  -- freebsd is not unix (in our definition)++------------------------------------------------------------------------------------------------+-- Platform-Specific Test Examples+-- +-- The `platform` function allows you to conditionally run tests based on the current platform.+-- It takes a platform expression string and a TestTree, and returns a TestTree that will only+-- run if the expression evaluates to true for the current platform.+--+-- The `platform` function works best with `tasty_` prefixed tests when using tasty-discover.+-- For custom tests that don't use the `tasty_` prefix, you can apply `platform` directly to TestTrees.+--+-- Platform expression syntax:+--   - Platform names: "linux", "darwin", "windows", "mingw32", "unix"+--   - Logical operators: "&" (AND), "|" (OR), "!" (NOT)+--   - Parentheses for grouping (future enhancement)+--   - Special platform "unix" matches both "linux" and "darwin"+--   - Platform name "windows" is mapped to "mingw32" (the actual System.Info.os value)+--+-- Examples:+--   platform "linux" test          -- Run only on Linux+--   platform "!windows" test       -- Run on all platforms except Windows  +--   platform "!windows & !darwin" test -- Run on platforms that are neither Windows nor Darwin+--   platform "linux | darwin" test     -- Run on Linux or Darwin (Unix-like systems)+--   platform "unix" test               -- Run on Unix-like systems (Linux or Darwin)++-- Simple platform-specific tests using tasty_ prefix+tasty_linuxOnly :: TestTree+tasty_linuxOnly = platform "linux" $ testCase "Linux-specific functionality" $ do+  -- This test only runs on Linux+  pure ()++tasty_notWindows :: TestTree  +tasty_notWindows = platform "!windows" $ testCase "Non-Windows functionality" $ do+  -- This test runs on all platforms except Windows+  pure ()++tasty_unixLike :: TestTree+tasty_unixLike = platform "unix" $ testCase "Unix-like systems" $ do+  -- This test runs on Linux and Darwin (Unix-like systems)+  pure ()++-- Complex platform expressions+tasty_complexPlatform1 :: TestTree+tasty_complexPlatform1 = platform "!windows & !darwin" $ testCase "Neither Windows nor Darwin" $ do+  -- This test runs on platforms that are neither Windows nor Darwin (e.g., Linux)+  pure ()++tasty_complexPlatform2 :: TestTree+tasty_complexPlatform2 = platform "linux | darwin" $ testCase "Linux or Darwin only" $ do+  -- This test runs on either Linux or Darwin, but not Windows+  pure ()++-- Property tests with platform filtering+tasty_platformSpecific :: TestTree+tasty_platformSpecific = platform "!windows" $ testProperty "Property that doesn't work on Windows" $ +  \(x :: Int) -> x + 0 == x++-- You can also combine platform filtering with other test transformations+-- using the Flavored type and function composition:++tasty_platformAndSkip :: TestTree  +tasty_platformAndSkip = platform "linux" $ skip $ testCase "Linux test that's also skipped" $ do+  -- This would only run on Linux, but it's also skipped, so it never actually runs+  pure ()++-- Test groups with platform filtering+tasty_platformGroup :: TestTree+tasty_platformGroup = platform "unix" $ testGroup "Unix-only tests" +  [ testCase "Unix test 1" $ pure ()+  , testCase "Unix test 2" $ pure ()+  , testProperty "Unix property" $ \(x :: Int) -> x >= 0 || x < 0+  ]++-- For more advanced use cases, you can use Flavored with platform filtering+-- This allows you to work with custom test types that have Tasty instances++tasty_platformFlavored :: Flavored TestTree+tasty_platformFlavored = flavored (platform "!windows") $ testCase "Advanced platform test" $ do+  -- This uses the Flavored pattern to apply platform filtering+  pure ()++-- You can also create platform-specific custom Property tests+tasty_platformProperty :: Flavored Property+tasty_platformProperty = flavored (platform "unix") $ property $ do+  -- This hedgehog property only runs on Unix-like systems+  x <- H.forAll $ G.int (R.linear 1 100)+  x H.=== x++-- Helper function to make testProperty respect SkipTest option+testPropertySkippable :: Testable a => String -> a -> TestTree+testPropertySkippable name prop = askOption $ \(TD.SkipTest shouldSkip) ->+  if shouldSkip+    then testCase (name ++ " " ++ yellowText "[SKIPPED]") (pure ())+    else testProperty name prop+  where+    yellowText text = setSGRCode [SetColor Foreground Vivid Yellow] ++ text ++ setSGRCode [Reset]++tasty_testTree_no_darwin :: Flavored (IO TestTree)+tasty_testTree_no_darwin =+  flavored (platform "!darwin") $ pure $ applySkips $ testGroup "Non-Darwin group"+    [ testProperty "Always succeeds" $ \(x :: Int) -> x == x+    , testCase "Another test" $ pure ()+    , testProperty "Yet another" $ \(x :: Int) -> x >= 0 || x < 0+    ]++------------------------------------------------------------------------------------------------+-- How to use the latest version of tasty-hedgehog+ hprop_reverse :: H.Property hprop_reverse = H.property $ do   xs <- H.forAll $ G.list (R.linear 0 100) G.alpha@@ -105,9 +401,10 @@ -- How to add custom support for golden tests.  data GoldenTest = GoldenTest FilePath (IO ByteString)+  deriving stock (Generic)  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_goldenTest :: GoldenTest+tasty_goldenTest = GoldenTest "test/SubMod/example.golden" $ return "test"
test/Driver.hs view
@@ -4,9 +4,13 @@  module Main (main, ingredients, tests) where +import Data.String (fromString) import Prelude+import qualified BackupFiles.ValidTest import qualified ConfigTest import qualified DiscoverTest+import qualified ModulesGlob.Sub.OneTest+import qualified ModulesGlob.TwoTest import qualified SubMod.FooBaz import qualified SubMod.PropTest import qualified SubMod.SubSubMod.PropTest@@ -20,6 +24,7 @@ import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.SmallCheck as SC +{- HLINT ignore "Evaluate" -} {- HLINT ignore "Use let" -}  @@ -40,49 +45,171 @@  tests :: IO T.TestTree tests = do-  t0 <- HS.testSpec "modules" ConfigTest.spec_modules+  t0 <- pure $ QC.testProperty "validTest" BackupFiles.ValidTest.prop_validTest -  t1 <- HS.testSpec "ignores" ConfigTest.spec_ignores+  t1 <- HS.testSpec "modules" ConfigTest.spec_modules -  t2 <- HS.testSpec "badModuleGlob" ConfigTest.spec_badModuleGlob+  t2 <- HS.testSpec "ignores" ConfigTest.spec_ignores -  t3 <- HS.testSpec "customModuleName" ConfigTest.spec_customModuleName+  t3 <- HS.testSpec "badModuleGlob" ConfigTest.spec_badModuleGlob -  t4 <- testCase "noTreeDisplayDefault" ConfigTest.unit_noTreeDisplayDefault+  t4 <- HS.testSpec "backupFilesIgnored" ConfigTest.spec_backupFilesIgnored -  t5 <- testCase "treeDisplay" ConfigTest.unit_treeDisplay+  t5 <- HS.testSpec "modulesGlobIgnoresDirectories" ConfigTest.spec_modulesGlobIgnoresDirectories -  t6 <- pure $ QC.testProperty "mkModuleTree" ConfigTest.prop_mkModuleTree+  t6 <- HS.testSpec "customModuleName" ConfigTest.spec_customModuleName -  t7 <- testCase "listCompare" DiscoverTest.unit_listCompare+  t7 <- testCase "noTreeDisplayDefault" ConfigTest.unit_noTreeDisplayDefault -  t8 <- pure $ QC.testProperty "additionCommutative" DiscoverTest.prop_additionCommutative+  t8 <- testCase "treeDisplay" ConfigTest.unit_treeDisplay -  t9 <- pure $ SC.testProperty "sortReverse" DiscoverTest.scprop_sortReverse+  t9 <- pure $ QC.testProperty "mkModuleTree" ConfigTest.prop_mkModuleTree -  t10 <- HS.testSpec "prelude" DiscoverTest.spec_prelude+  t10 <- HS.testSpec "commentHandling" ConfigTest.spec_commentHandling -  t11 <- testGroup "addition" DiscoverTest.test_addition+  t11 <- TD.tasty (TD.description "assertionExample" <> TD.name "ConfigTest.tasty_assertionExample") ConfigTest.tasty_assertionExample -  t12 <- testGroup "multiplication" DiscoverTest.test_multiplication+  t12 <- TD.tasty (TD.description "skippedAssertion" <> TD.name "ConfigTest.tasty_skippedAssertion") ConfigTest.tasty_skippedAssertion -  t13 <- testGroup "generateTree" DiscoverTest.test_generateTree+  t13 <- TD.tasty (TD.description "platformAssertion" <> TD.name "ConfigTest.tasty_platformAssertion") ConfigTest.tasty_platformAssertion -  t14 <- testGroup "generateTrees" DiscoverTest.test_generateTrees+  t14 <- HS.testSpec "symlinksNotFollowed" ConfigTest.spec_symlinksNotFollowed -  t15 <- TD.tasty (TD.description "reverse" <> TD.name "DiscoverTest.tasty_reverse") DiscoverTest.tasty_reverse+  t15 <- TD.tasty (TD.description "symlinksNotFollowed" <> TD.name "ConfigTest.tasty_symlinksNotFollowed") ConfigTest.tasty_symlinksNotFollowed -  t16 <- pure $ H.testProperty "reverse" DiscoverTest.hprop_reverse+  t16 <- testCase "listCompare" DiscoverTest.unit_listCompare -  t17 <- pure $ QC.testProperty "additionCommutative" SubMod.FooBaz.prop_additionCommutative+  t17 <- pure $ QC.testProperty "additionCommutative" DiscoverTest.prop_additionCommutative -  t18 <- pure $ QC.testProperty "multiplationDistributiveOverAddition" SubMod.FooBaz.prop_multiplationDistributiveOverAddition+  t18 <- pure $ SC.testProperty "sortReverse" DiscoverTest.scprop_sortReverse -  t19 <- pure $ QC.testProperty "additionAssociative" SubMod.PropTest.prop_additionAssociative+  t19 <- HS.testSpec "prelude" DiscoverTest.spec_prelude -  t20 <- pure $ QC.testProperty "additionCommutative" SubMod.SubSubMod.PropTest.prop_additionCommutative+  t20 <- testGroup "addition" DiscoverTest.test_addition -  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]+  t21 <- testGroup "multiplication" DiscoverTest.test_multiplication++  t22 <- testGroup "generateTree" DiscoverTest.test_generateTree++  t23 <- testGroup "generateTrees" DiscoverTest.test_generateTrees++  t24 <- TD.tasty (TD.description "reverse" <> TD.name "DiscoverTest.tasty_reverse") DiscoverTest.tasty_reverse++  t25 <- TD.tasty (TD.description "skip me" <> TD.name "DiscoverTest.tasty_skip_me") DiscoverTest.tasty_skip_me++  t26 <- TD.tasty (TD.description "tree of testCase not skipped" <> TD.name "DiscoverTest.tasty_tree_of_testCase_not_skipped") DiscoverTest.tasty_tree_of_testCase_not_skipped++  t27 <- testCase "platformExpression linux" DiscoverTest.unit_platformExpression_linux++  t28 <- testCase "platformExpression darwin" DiscoverTest.unit_platformExpression_darwin++  t29 <- testCase "platformExpression windows" DiscoverTest.unit_platformExpression_windows++  t30 <- testCase "platformExpression mingw32" DiscoverTest.unit_platformExpression_mingw32++  t31 <- testCase "platformExpression not linux" DiscoverTest.unit_platformExpression_not_linux++  t32 <- testCase "platformExpression not linux false" DiscoverTest.unit_platformExpression_not_linux_false++  t33 <- testCase "platformExpression not darwin" DiscoverTest.unit_platformExpression_not_darwin++  t34 <- testCase "platformExpression not darwin false" DiscoverTest.unit_platformExpression_not_darwin_false++  t35 <- testCase "platformExpression not windows" DiscoverTest.unit_platformExpression_not_windows++  t36 <- testCase "platformExpression not windows false" DiscoverTest.unit_platformExpression_not_windows_false++  t37 <- testCase "platformExpression not mingw32" DiscoverTest.unit_platformExpression_not_mingw32++  t38 <- testCase "platformExpression not mingw32 false" DiscoverTest.unit_platformExpression_not_mingw32_false++  t39 <- testCase "platformExpression not unix" DiscoverTest.unit_platformExpression_not_unix++  t40 <- testCase "platformExpression not unix false linux" DiscoverTest.unit_platformExpression_not_unix_false_linux++  t41 <- testCase "platformExpression not unix false darwin" DiscoverTest.unit_platformExpression_not_unix_false_darwin++  t42 <- testCase "platformExpression and true" DiscoverTest.unit_platformExpression_and_true++  t43 <- testCase "platformExpression and false" DiscoverTest.unit_platformExpression_and_false++  t44 <- testCase "platformExpression and false windows" DiscoverTest.unit_platformExpression_and_false_windows++  t45 <- testCase "platformExpression and both positive" DiscoverTest.unit_platformExpression_and_both_positive++  t46 <- testCase "platformExpression and both positive false" DiscoverTest.unit_platformExpression_and_both_positive_false++  t47 <- testCase "platformExpression and three terms" DiscoverTest.unit_platformExpression_and_three_terms++  t48 <- testCase "platformExpression or true" DiscoverTest.unit_platformExpression_or_true++  t49 <- testCase "platformExpression or true darwin" DiscoverTest.unit_platformExpression_or_true_darwin++  t50 <- testCase "platformExpression or false" DiscoverTest.unit_platformExpression_or_false++  t51 <- testCase "platformExpression or windows mingw32" DiscoverTest.unit_platformExpression_or_windows_mingw32++  t52 <- testCase "platformExpression or three platforms" DiscoverTest.unit_platformExpression_or_three_platforms++  t53 <- testCase "platformExpression unix linux" DiscoverTest.unit_platformExpression_unix_linux++  t54 <- testCase "platformExpression unix darwin" DiscoverTest.unit_platformExpression_unix_darwin++  t55 <- testCase "platformExpression unix windows" DiscoverTest.unit_platformExpression_unix_windows++  t56 <- testCase "platformExpression complex1" DiscoverTest.unit_platformExpression_complex1++  t57 <- testCase "platformExpression complex2" DiscoverTest.unit_platformExpression_complex2++  t58 <- testCase "platformExpression unknown" DiscoverTest.unit_platformExpression_unknown++  t59 <- testCase "platformExpression empty" DiscoverTest.unit_platformExpression_empty++  t60 <- testCase "platformExpression unknown current" DiscoverTest.unit_platformExpression_unknown_current++  t61 <- testCase "platformExpression unix freebsd" DiscoverTest.unit_platformExpression_unix_freebsd++  t62 <- testCase "platformExpression not unix freebsd" DiscoverTest.unit_platformExpression_not_unix_freebsd++  t63 <- TD.tasty (TD.description "linuxOnly" <> TD.name "DiscoverTest.tasty_linuxOnly") DiscoverTest.tasty_linuxOnly++  t64 <- TD.tasty (TD.description "notWindows" <> TD.name "DiscoverTest.tasty_notWindows") DiscoverTest.tasty_notWindows++  t65 <- TD.tasty (TD.description "unixLike" <> TD.name "DiscoverTest.tasty_unixLike") DiscoverTest.tasty_unixLike++  t66 <- TD.tasty (TD.description "complexPlatform1" <> TD.name "DiscoverTest.tasty_complexPlatform1") DiscoverTest.tasty_complexPlatform1++  t67 <- TD.tasty (TD.description "complexPlatform2" <> TD.name "DiscoverTest.tasty_complexPlatform2") DiscoverTest.tasty_complexPlatform2++  t68 <- TD.tasty (TD.description "platformSpecific" <> TD.name "DiscoverTest.tasty_platformSpecific") DiscoverTest.tasty_platformSpecific++  t69 <- TD.tasty (TD.description "platformAndSkip" <> TD.name "DiscoverTest.tasty_platformAndSkip") DiscoverTest.tasty_platformAndSkip++  t70 <- TD.tasty (TD.description "platformGroup" <> TD.name "DiscoverTest.tasty_platformGroup") DiscoverTest.tasty_platformGroup++  t71 <- TD.tasty (TD.description "platformFlavored" <> TD.name "DiscoverTest.tasty_platformFlavored") DiscoverTest.tasty_platformFlavored++  t72 <- TD.tasty (TD.description "platformProperty" <> TD.name "DiscoverTest.tasty_platformProperty") DiscoverTest.tasty_platformProperty++  t73 <- TD.tasty (TD.description "testTree no darwin" <> TD.name "DiscoverTest.tasty_testTree_no_darwin") DiscoverTest.tasty_testTree_no_darwin++  t74 <- pure $ H.testPropertyNamed "reverse" (fromString "DiscoverTest.hprop_reverse") DiscoverTest.hprop_reverse++  t75 <- TD.tasty (TD.description "goldenTest" <> TD.name "DiscoverTest.tasty_goldenTest") DiscoverTest.tasty_goldenTest++  t76 <- pure $ QC.testProperty "subTest" ModulesGlob.Sub.OneTest.prop_subTest++  t77 <- pure $ QC.testProperty "topLevelTest" ModulesGlob.TwoTest.prop_topLevelTest++  t78 <- pure $ QC.testProperty "additionCommutative" SubMod.FooBaz.prop_additionCommutative++  t79 <- pure $ QC.testProperty "multiplationDistributiveOverAddition" SubMod.FooBaz.prop_multiplationDistributiveOverAddition++  t80 <- pure $ QC.testProperty "additionAssociative" SubMod.PropTest.prop_additionAssociative++  t81 <- 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,t21,t22,t23,t24,t25,t26,t27,t28,t29,t30,t31,t32,t33,t34,t35,t36,t37,t38,t39,t40,t41,t42,t43,t44,t45,t46,t47,t48,t49,t50,t51,t52,t53,t54,t55,t56,t57,t58,t59,t60,t61,t62,t63,t64,t65,t66,t67,t68,t69,t70,t71,t72,t73,t74,t75,t76,t77,t78,t79,t80,t81] ingredients :: [T.Ingredient] ingredients = T.defaultIngredients main :: IO ()
+ test/ModulesGlob/Sub/OneTest.hs view
@@ -0,0 +1,4 @@+module ModulesGlob.Sub.OneTest where++prop_subTest :: Bool -> Bool+prop_subTest _ = True
+ test/ModulesGlob/TwoTest.hs view
@@ -0,0 +1,4 @@+module ModulesGlob.TwoTest where++prop_topLevelTest :: Bool -> Bool+prop_topLevelTest _ = True