tasty-hedgehog-1.4.0.2/0000755000000000000000000000000007346545000012761 5ustar0000000000000000tasty-hedgehog-1.4.0.2/LICENCE0000644000000000000000000000306607346545000013753 0ustar0000000000000000Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of QFPL nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. tasty-hedgehog-1.4.0.2/Setup.hs0000644000000000000000000000005607346545000014416 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-hedgehog-1.4.0.2/changelog.md0000644000000000000000000000432707346545000015240 0ustar0000000000000000# Revision history for tasty-hedgehog ## 1.4.0.2 -- 2023-08-07 * Support hedgehog 1.4 ## 1.4.0.1 -- 2023-03-15 * Support base 4.18 (GHC 9.6) * Improve suggested test replay command ## 1.4.0.0 -- 2022-10-12 * Support `hedgehog-1.2`. This is a breaking change due to `hedgehog`'s [new mechanism for skipping to a particular test and shrink result](https://github.com/hedgehogqa/haskell-hedgehog/pull/454). The `--hedgehog-replay` option now expects a `Skip` value and a `Seed`, for example: `stack test --test-arguments='--pattern "$NF ~ /badReverse involutive fails/" --hedgehog-replay "3:b2 Seed 10332913068362713902 1302058653756691475"'` ([#63](https://github.com/qfpl/tasty-hedgehog/pull/63)) ## 1.3.1.0 -- 2022-10-03 * The instructions for reproducing test failures are now more clearly distinguished from `hedgehog`'s own instructions and include a pattern in the example to limit which tests are re-run. ([#62](https://github.com/qfpl/tasty-hedgehog/pull/62)) ## 1.3.0.0 -- 2022-08-22 * The `testProperty` function has been undeprecated. Its behaviour differs from that in version `1.1.0.0` and below in that it now passes no `PropertyName` to Hedgehog. Therefore, Hedgehog will render the text `` in its instructions for reproducing test failures, as opposed to whatever description is provided for `testProperty`. ## 1.2.0.0 -- 2022-03-07 * Add `testPropertyNamed` function and deprecate `testProperty`. ## 1.1.0.0 -- 2021-04-03 * Add fromGroup function ## 1.0.1.0 -- 2021-01-25 * Automatically enable or disable colour, based on the same criteria that hedgehog itself checks. ## 1.0.0.2 -- 2020-01-16 * Upgrade to `hedgehog-1.0.2` ## 1.0.0.1 -- 2019-05-22 * Fixed test result reporting to made plain hedgehog's messages (fixes #30) ## 1.0.0.0 -- 2019-05-17 * Removed support for GHC < 8 * Upgrade to `hedgehog-1` ## 0.2.0.0 -- 2018-03-13 * Removes the verbosity option, which was unsupported * Fixes a bug in configuration option handling, which was overwriting use configuration with the defaults. ## 0.1.0.2 -- 2018-01-22 * Ease bounds to allow for `tasty` 1.0. ## 0.1.0.1 -- 2018-08-24 * Exposed the various tasty options. ## 0.1.0.0 -- 2017-08-24 * First version. Released on an unsuspecting world. tasty-hedgehog-1.4.0.2/src/Test/Tasty/0000755000000000000000000000000007346545000015573 5ustar0000000000000000tasty-hedgehog-1.4.0.2/src/Test/Tasty/Hedgehog.hs0000644000000000000000000002056107346545000017645 0ustar0000000000000000-- | This package lets you test Hedgehog properties with tasty. -- -- Typical usage would look like this: -- -- @ -- testGroup "tasty-hedgehog tests" [ -- testPropertyNamed "reverse involutive" "prop_reverse_involutive" prop_reverse_involutive -- , testPropertyNamed "sort idempotent" "prop_sort_idempotent" prop_sort_idempotent -- ] -- @ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Tasty.Hedgehog ( testProperty , testPropertyNamed , fromGroup -- * Options you can pass in via tasty , HedgehogReplay(..) , HedgehogShowReplay(..) , HedgehogTestLimit(..) , HedgehogDiscardLimit(..) , HedgehogShrinkLimit(..) , HedgehogShrinkRetries(..) ) where import Data.Maybe (fromMaybe) import Data.Typeable import qualified Test.Tasty as T import qualified Test.Tasty.Providers as T import Test.Tasty.Options import Hedgehog import Hedgehog.Internal.Config (UseColor, detectColor) import Hedgehog.Internal.Property import Hedgehog.Internal.Runner as H import Hedgehog.Internal.Report import Hedgehog.Internal.Seed as Seed data HP = HP T.TestName (Maybe PropertyName) Property deriving (Typeable) -- | Create a 'T.TestTree' from a Hedgehog 'Property'. testProperty :: T.TestName -> Property -> T.TestTree testProperty name prop = T.singleTest name (HP name Nothing prop) -- | `testPropertyNamed` @testName propertyName property@ creates a -- 'T.TestTree' from @property@ using @testName@ as the displayed -- description for the property. The @propertyName@ is used by Hedgehog -- when a failure occurs to provide instructions for how to re-run -- the property and should normally be set to a string representation -- of the @property@ argument. -- -- @ -- testPropertyNamed -- "reverse is involutive" -- "prop_reverse_involutive" -- prop_reverse_involutive -- @ -- -- @since 1.2.0.0 testPropertyNamed :: T.TestName -> PropertyName -> Property -> T.TestTree testPropertyNamed name propName prop = T.singleTest name (HP name (Just propName) prop) -- | Create a 'T.TestTree' from a Hedgehog 'Group'. fromGroup :: Group -> T.TestTree fromGroup group = T.testGroup (unGroupName $ groupName group) $ map mkTestTree (groupProperties group) where mkTestTree :: (PropertyName, Property) -> T.TestTree mkTestTree (propName, prop) = testProperty (unPropertyName propName) prop -- | The replay token to use for replaying a previous test run newtype HedgehogReplay = HedgehogReplay (Maybe (Skip, Seed)) deriving (Typeable) instance IsOption HedgehogReplay where defaultValue = HedgehogReplay Nothing parseValue v = HedgehogReplay . Just <$> replay -- Reads a replay token in the form "{skip} {seed}" where replay = (,) <$> skipDecompress (unwords skip) <*> safeRead (unwords seed) (skip, seed) = splitAt 1 $ words v optionName = return "hedgehog-replay" optionHelp = return "Replay token to use for replaying a previous test run" -- | If a test case fails, show a replay token for replaying tests newtype HedgehogShowReplay = HedgehogShowReplay Bool deriving (Typeable) instance IsOption HedgehogShowReplay where defaultValue = HedgehogShowReplay True parseValue = fmap HedgehogShowReplay . safeRead optionName = return "hedgehog-show-replay" optionHelp = return "Show a replay token for replaying tests" -- | The number of successful test cases required before Hedgehog will pass a test newtype HedgehogTestLimit = HedgehogTestLimit (Maybe TestLimit) deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogTestLimit where defaultValue = HedgehogTestLimit Nothing parseValue = fmap (HedgehogTestLimit . Just . TestLimit) . safeRead optionName = return "hedgehog-tests" optionHelp = return "Number of successful test cases required before Hedgehog will pass a test" -- | The number of discarded cases allowed before Hedgehog will fail a test newtype HedgehogDiscardLimit = HedgehogDiscardLimit (Maybe DiscardLimit) deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogDiscardLimit where defaultValue = HedgehogDiscardLimit Nothing parseValue = fmap (HedgehogDiscardLimit . Just . DiscardLimit) . safeRead optionName = return "hedgehog-discards" optionHelp = return "Number of discarded cases allowed before Hedgehog will fail a test" -- | The number of shrinks allowed before Hedgehog will fail a test newtype HedgehogShrinkLimit = HedgehogShrinkLimit (Maybe ShrinkLimit) deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogShrinkLimit where defaultValue = HedgehogShrinkLimit Nothing parseValue = fmap (HedgehogShrinkLimit . Just . ShrinkLimit) . safeRead optionName = return "hedgehog-shrinks" optionHelp = return "Number of shrinks allowed before Hedgehog will fail a test" -- | The number of times to re-run a test during shrinking newtype HedgehogShrinkRetries = HedgehogShrinkRetries (Maybe ShrinkRetries) deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogShrinkRetries where defaultValue = HedgehogShrinkRetries Nothing parseValue = fmap (HedgehogShrinkRetries . Just . ShrinkRetries) . safeRead optionName = return "hedgehog-retries" optionHelp = return "Number of times to re-run a test during shrinking" propertyTestLimit :: PropertyConfig -> TestLimit propertyTestLimit = let getTestLimit (EarlyTermination _ tests) = tests getTestLimit (NoEarlyTermination _ tests) = tests getTestLimit (NoConfidenceTermination tests) = tests in getTestLimit . propertyTerminationCriteria reportToProgress :: PropertyConfig -> Report Progress -> T.Progress reportToProgress config Report{ reportTests = testsDone, reportStatus = status } = let TestLimit testLimit = propertyTestLimit config ShrinkLimit shrinkLimit = propertyShrinkLimit config ratio x y = 1.0 * fromIntegral x / fromIntegral y in -- TODO add details for tests run / discarded / shrunk case status of Running -> T.Progress "Running" (ratio testsDone testLimit) Shrinking fr -> T.Progress "Shrinking" (ratio (failureShrinks fr) shrinkLimit) reportOutput :: Bool -> UseColor -> T.TestName -> Maybe PropertyName -> Report Result -> IO String reportOutput showReplay useColor testName name report = do s <- renderResult useColor name report pure $ case reportStatus report of Failed fr -> let count = reportTests report seed = reportSeed report discards = reportDiscards report shrinkPath = failureShrinkPath fr replayStr = if showReplay then "\nUse \"--pattern \'$NF ~ /" ++ testName ++ "/\' --hedgehog-replay \'" ++ skipCompress (SkipToShrink count discards shrinkPath) ++ " " ++ show seed ++ "\'\" to reproduce from the command-line." else "" in s ++ replayStr ++ "\n" _ -> s instance T.IsTest HP where testOptions = return [ Option (Proxy :: Proxy HedgehogReplay) , Option (Proxy :: Proxy HedgehogShowReplay) , Option (Proxy :: Proxy HedgehogTestLimit) , Option (Proxy :: Proxy HedgehogDiscardLimit) , Option (Proxy :: Proxy HedgehogShrinkLimit) , Option (Proxy :: Proxy HedgehogShrinkRetries) ] run opts (HP testName name (Property pConfig pTest)) yieldProgress = do useColor <- detectColor let HedgehogReplay replay = lookupOption opts HedgehogShowReplay showReplay = lookupOption opts HedgehogTestLimit mTests = lookupOption opts HedgehogDiscardLimit mDiscards = lookupOption opts HedgehogShrinkLimit mShrinks = lookupOption opts HedgehogShrinkRetries mRetries = lookupOption opts config = PropertyConfig (fromMaybe (propertyDiscardLimit pConfig) mDiscards) (fromMaybe (propertyShrinkLimit pConfig) mShrinks) (fromMaybe (propertyShrinkRetries pConfig) mRetries) (NoConfidenceTermination $ fromMaybe (propertyTestLimit pConfig) mTests) (maybe Nothing (Just . fst) replay) randSeed <- Seed.random let seed = maybe randSeed snd replay report <- checkReport config 0 seed pTest (yieldProgress . reportToProgress config) let resultFn = if reportStatus report == OK then T.testPassed else T.testFailed out <- reportOutput showReplay useColor testName name report return $ resultFn out tasty-hedgehog-1.4.0.2/tasty-hedgehog.cabal0000644000000000000000000000340307346545000016661 0ustar0000000000000000name: tasty-hedgehog version: 1.4.0.2 license: BSD3 license-file: LICENCE author: Dave Laing maintainer: dave.laing.80@gmail.com copyright: Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. description: Integrates the with the . category: Testing synopsis: Integration for tasty and hedgehog. homepage: https://github.com/qfpl/tasty-hedgehog bug-reports: https://github.com/qfpl/tasty-hedgehog/issues build-type: Simple extra-source-files: changelog.md cabal-version: >=1.10 tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1 source-repository head type: git location: git@github.com:qfpl/tasty-hedgehog.git library exposed-modules: Test.Tasty.Hedgehog build-depends: base >= 4.8 && <4.19 , tagged >= 0.8 && < 0.9 , tasty >= 0.11 && < 1.5 , hedgehog >= 1.4 && < 1.5 hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010 test-suite tasty-hedgehog-tests type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: base >= 4.8 && <4.19 , tasty >= 0.11 && < 1.5 , tasty-expected-failure >= 0.11 && < 0.13 , hedgehog >= 1.4 && < 1.5 , tasty-hedgehog ghc-options: -Wall default-language: Haskell2010 tasty-hedgehog-1.4.0.2/test/0000755000000000000000000000000007346545000013740 5ustar0000000000000000tasty-hedgehog-1.4.0.2/test/Main.hs0000644000000000000000000000267107346545000015166 0ustar0000000000000000{-# language OverloadedStrings #-} module Main where import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.Hedgehog genAlphaList :: Gen String genAlphaList = Gen.list (Range.linear 0 100) Gen.alpha test_involutive :: (MonadTest m, Eq a, Show a) => (a -> a) -> a -> m () test_involutive f x = f (f x) === x prop_reverse_involutive :: Property prop_reverse_involutive = property $ do xs <- forAll genAlphaList classify "empty" $ length xs == 0 classify "small" $ length xs < 10 classify "large" $ length xs >= 10 test_involutive reverse xs badReverse :: [a] -> [a] badReverse [] = [] badReverse [_] = [] badReverse (x : xs) = badReverse xs ++ [x] prop_badReverse_involutive :: Property prop_badReverse_involutive = property $ do xs <- forAll genAlphaList test_involutive badReverse xs main :: IO () main = defaultMain $ testGroup "tasty-hedgehog tests" [ testProperty "reverse involutive" prop_reverse_involutive , expectFail $ testProperty "badReverse involutive fails" prop_badReverse_involutive , testPropertyNamed "reverse involutive" "prop_reverse_involutive" prop_reverse_involutive , expectFail $ testPropertyNamed "badReverse involutive fails" "prop_badReverse_involutive" prop_badReverse_involutive ]