tasty-hedgehog-0.2.0.0/0000755000000000000000000000000013251622467012761 5ustar0000000000000000tasty-hedgehog-0.2.0.0/tasty-hedgehog.cabal0000644000000000000000000000307713251622467016670 0ustar0000000000000000name: tasty-hedgehog version: 0.2.0.0 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 hedgehog testing library with the tasty testing framework. category: Testing synopsis: Integration for tasty and hedgehog. homepage: https://github.com/qfpl/tasty-hedghog bug-reports: https://github.com/qfpl/tasty-hedgehog/issues build-type: Simple extra-source-files: changelog.md cabal-version: >=1.10 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.11 , tagged >= 0.8 && < 0.9 , tasty >= 0.11 && < 1.1 , hedgehog >= 0.5 && < 0.6 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.11 , tasty >= 0.11 && < 1.1 , tasty-expected-failure >= 0.11 && < 0.12 , hedgehog >= 0.5 && < 0.6 , tasty-hedgehog ghc-options: -Wall default-language: Haskell2010 tasty-hedgehog-0.2.0.0/LICENCE0000644000000000000000000000306613251622467013753 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-0.2.0.0/Setup.hs0000644000000000000000000000005613251622467014416 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-hedgehog-0.2.0.0/changelog.md0000644000000000000000000000067313251622467015240 0ustar0000000000000000# Revision history for tasty-hedgehog ## 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-0.2.0.0/test/0000755000000000000000000000000013251622467013740 5ustar0000000000000000tasty-hedgehog-0.2.0.0/test/Main.hs0000644000000000000000000000201213251622467015153 0ustar0000000000000000module 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 test_involutive reverse xs badReverse :: [a] -> [a] badReverse [] = [] badReverse [_] = [] badReverse as = reverse as 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 ] tasty-hedgehog-0.2.0.0/src/0000755000000000000000000000000013251622467013550 5ustar0000000000000000tasty-hedgehog-0.2.0.0/src/Test/0000755000000000000000000000000013251622467014467 5ustar0000000000000000tasty-hedgehog-0.2.0.0/src/Test/Tasty/0000755000000000000000000000000013251622467015573 5ustar0000000000000000tasty-hedgehog-0.2.0.0/src/Test/Tasty/Hedgehog.hs0000644000000000000000000001473713251622467017655 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.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" 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@(Report _ _ status) = do -- TODO add details for tests run / discarded / shrunk s <- renderResult Nothing (Just (PropertyName name)) report pure $ case status of Failed fr -> do let size = failureSize fr seed = failureSeed fr replayStr = if showReplay then "\nUse '--hedgehog-replay \"" ++ show size ++ " " ++ show seed ++ "\"' to reproduce." else "" s ++ replayStr GaveUp -> "Gave up" OK -> "OK" 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 (propertyTestLimit pConfig) mTests) (fromMaybe (propertyDiscardLimit pConfig) mDiscards) (fromMaybe (propertyShrinkLimit pConfig) mShrinks) (fromMaybe (propertyShrinkRetries pConfig) mRetries) 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