diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,11 @@ # 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. diff --git a/src/Test/Tasty/Hedgehog.hs b/src/Test/Tasty/Hedgehog.hs --- a/src/Test/Tasty/Hedgehog.hs +++ b/src/Test/Tasty/Hedgehog.hs @@ -1,27 +1,27 @@ -- | This package lets you test Hedgehog properties with tasty. --- +-- -- Typical usage would look like this: -- --- @ --- testGroup "tasty-hedgehog tests" [ +-- @ +-- 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(..) - , HedgehogVerbose(..) , HedgehogTestLimit(..) , HedgehogDiscardLimit(..) , HedgehogShrinkLimit(..) , HedgehogShrinkRetries(..) ) where +import Data.Maybe (fromMaybe) import Data.Typeable import qualified Test.Tasty.Providers as T @@ -63,64 +63,53 @@ optionName = return "hedgehog-show-replay" optionHelp = return "Show a replay token for replaying tests" --- | Show the generated Hedgehog test cases -newtype HedgehogVerbose = HedgehogVerbose Bool - deriving (Typeable) - -instance IsOption HedgehogVerbose where - defaultValue = HedgehogVerbose False - parseValue = fmap HedgehogVerbose . safeRead - optionName = return "hedgehog-verbose" - optionHelp = return "Show the generated Hedgehog test cases" - optionCLParser = flagCLParser Nothing (HedgehogVerbose True) - -- | The number of successful test cases required before Hedgehog will pass a test -newtype HedgehogTestLimit = HedgehogTestLimit Int - deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Typeable) +newtype HedgehogTestLimit = HedgehogTestLimit (Maybe TestLimit) + deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogTestLimit where - defaultValue = 100 - parseValue = fmap HedgehogTestLimit . safeRead + 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 Int - deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Typeable) +newtype HedgehogDiscardLimit = HedgehogDiscardLimit (Maybe DiscardLimit) + deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogDiscardLimit where - defaultValue = 100 - parseValue = fmap HedgehogDiscardLimit . safeRead + 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 Int - deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Typeable) +newtype HedgehogShrinkLimit = HedgehogShrinkLimit (Maybe ShrinkLimit) + deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogShrinkLimit where - defaultValue = 100 - parseValue = fmap HedgehogShrinkLimit . safeRead + 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 Int - deriving (Eq, Ord, Show, Num, Enum, Real, Integral, Typeable) +newtype HedgehogShrinkRetries = HedgehogShrinkRetries (Maybe ShrinkRetries) + deriving (Eq, Ord, Show, Typeable) instance IsOption HedgehogShrinkRetries where - defaultValue = 10 - parseValue = fmap HedgehogShrinkRetries . safeRead + 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 :: Int - -> Int - -> Int + +reportToProgress :: PropertyConfig -> Report Progress -> T.Progress -reportToProgress testLimit _ shrinkLimit (Report testsDone _ status) = +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 @@ -131,11 +120,10 @@ T.Progress "Shrinking" (ratio (failureShrinks fr) shrinkLimit) reportOutput :: Bool - -> Bool -> String -> Report Result -> IO String -reportOutput _ showReplay name report@(Report _ _ status) = do +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 @@ -155,40 +143,38 @@ testOptions = return [ Option (Proxy :: Proxy HedgehogReplay) , Option (Proxy :: Proxy HedgehogShowReplay) - , Option (Proxy :: Proxy HedgehogVerbose) , Option (Proxy :: Proxy HedgehogTestLimit) , Option (Proxy :: Proxy HedgehogDiscardLimit) , Option (Proxy :: Proxy HedgehogShrinkLimit) , Option (Proxy :: Proxy HedgehogShrinkRetries) ] - run opts (HP name (Property _ pTest)) yieldProgress = do + run opts (HP name (Property pConfig pTest)) yieldProgress = do let HedgehogReplay replay = lookupOption opts HedgehogShowReplay showReplay = lookupOption opts - HedgehogVerbose verbose = lookupOption opts - HedgehogTestLimit tests = lookupOption opts - HedgehogDiscardLimit discards = lookupOption opts - HedgehogShrinkLimit shrinks = lookupOption opts - HedgehogShrinkRetries retries = lookupOption opts + HedgehogTestLimit mTests = lookupOption opts + HedgehogDiscardLimit mDiscards = lookupOption opts + HedgehogShrinkLimit mShrinks = lookupOption opts + HedgehogShrinkRetries mRetries = lookupOption opts config = PropertyConfig - (TestLimit tests) - (DiscardLimit discards) - (ShrinkLimit shrinks) - (ShrinkRetries retries) + (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 tests discards shrinks) + report <- checkReport config size seed pTest (yieldProgress . reportToProgress config) let resultFn = if reportStatus report == OK then T.testPassed else T.testFailed - out <- reportOutput verbose showReplay name report + out <- reportOutput showReplay name report return $ resultFn out diff --git a/tasty-hedgehog.cabal b/tasty-hedgehog.cabal --- a/tasty-hedgehog.cabal +++ b/tasty-hedgehog.cabal @@ -1,13 +1,13 @@ name: tasty-hedgehog -version: 0.1.0.2 +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. +description: Integrates the hedgehog testing library with the tasty testing framework. category: Testing -synopsis: Integrates the hedgehog testing library with the tasty testing framework. +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