tasty-hedgehog-1.0.0.2/0000755000000000000000000000000007346545000012755 5ustar0000000000000000tasty-hedgehog-1.0.0.2/LICENCE0000644000000000000000000000306607346545000013747 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.0.0.2/Setup.hs0000644000000000000000000000005607346545000014412 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-hedgehog-1.0.0.2/changelog.md0000755000000000000000000000126107346545000015231 0ustar0000000000000000# Revision history for tasty-hedgehog ## 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.0.0.2/src/Test/Tasty/0000755000000000000000000000000007346545000015567 5ustar0000000000000000tasty-hedgehog-1.0.0.2/src/Test/Tasty/Hedgehog.hs0000644000000000000000000001546407346545000017647 0ustar0000000000000000-- | This package lets you test Hedgehog properties with tasty. -- -- Typical usage would look like this: -- -- @ -- testGroup "tasty-hedgehog tests" [ -- testProperty "reverse involutive" prop_reverse_involutive -- , testProperty "sort idempotent" prop_sort_idempotent -- ] -- @ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Tasty.Hedgehog ( testProperty -- * 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.Providers as T import Test.Tasty.Options import Hedgehog import Hedgehog.Internal.Config (UseColor(DisableColor)) 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 Property deriving (Typeable) -- | Create a 'Test' from a Hedgehog property testProperty :: T.TestName -> Property -> T.TestTree testProperty name prop = T.singleTest name (HP name prop) -- | The replay token to use for replaying a previous test run newtype HedgehogReplay = HedgehogReplay (Maybe (Size, Seed)) deriving (Typeable) instance IsOption HedgehogReplay where defaultValue = HedgehogReplay Nothing parseValue v = HedgehogReplay . Just <$> replay -- Reads a replay token in the form "{size} {seed}" where replay = (,) <$> safeRead (unwords size) <*> safeRead (unwords seed) (size, seed) = splitAt 2 $ 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 testsDone _ _ 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 -> String -> Report Result -> IO String reportOutput showReplay name report = do s <- renderResult DisableColor (Just (PropertyName name)) report pure $ case reportStatus report of Failed fr -> let size = failureSize fr seed = failureSeed fr replayStr = if showReplay then "\nUse '--hedgehog-replay \"" ++ show size ++ " " ++ show seed ++ "\"' to reproduce." 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 name (Property pConfig pTest)) yieldProgress = do 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) randSeed <- Seed.random let size = maybe 0 fst replay seed = maybe randSeed snd replay report <- checkReport config size seed pTest (yieldProgress . reportToProgress config) let resultFn = if reportStatus report == OK then T.testPassed else T.testFailed out <- reportOutput showReplay name report return $ resultFn out tasty-hedgehog-1.0.0.2/tasty-hedgehog.cabal0000644000000000000000000000337407346545000016664 0ustar0000000000000000name: tasty-hedgehog version: 1.0.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.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.14 , tagged >= 0.8 && < 0.9 , tasty >= 0.11 && < 1.3 , hedgehog >= 1.0.2 && < 1.0.3 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.14 , tasty >= 0.11 && < 1.3 , tasty-expected-failure >= 0.11 && < 0.12 , hedgehog >= 1.0.2 && < 1.0.3 , tasty-hedgehog ghc-options: -Wall default-language: Haskell2010 tasty-hedgehog-1.0.0.2/test/0000755000000000000000000000000007346545000013734 5ustar0000000000000000tasty-hedgehog-1.0.0.2/test/Main.hs0000644000000000000000000000226007346545000015154 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 ]