hedgehog 1.1 → 1.1.1

raw patch · 7 files changed

+78/−16 lines, 7 filesdep ~mmorphdep ~mtldep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mmorph, mtl, text, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−2
• hedgehog.cabal +3/−3
• src/Hedgehog/Internal/Config.hs +38/−0
• src/Hedgehog/Internal/Property.hs +2/−2
• src/Hedgehog/Internal/Report.hs +0/−1
• src/Hedgehog/Internal/Runner.hs +16/−7
• src/Hedgehog/Internal/Seed.hs +4/−1

@@ -1,3 +1,8 @@+## Version 1.1.1 (2022-01-29)++* Support using fixed seed via `HEDGEHOG_SEED` ([#446][446], [@simfleischman][simfleischman] / [@moodmosaic][moodmosaic])+* Better 'cover' example code in haddocks ([#423][423], [@jhrcek][jhrcek])+ ## Version 1.1 (2022-01-27)  - Replace HTraversable with TraversableB (from barbies) ([#412][412], [@ocharles][ocharles])@@ -234,18 +239,26 @@   https://github.com/utdemir [patrickt]:   https://github.com/patrickt+[simfleischman]:+  https://github.com/simfleischman+[jhrcek]:+  https://github.com/jhrcek  +[446]:+  https://github.com/hedgehogqa/haskell-hedgehog/pull/446 [436]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/436-[421]:-  https://github.com/hedgehogqa/haskell-hedgehog/pull/421+[423]:+  https://github.com/hedgehogqa/haskell-hedgehog/pull/423 [415]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/415 [414]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/414 [413]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/413+[412]:+  https://github.com/hedgehogqa/haskell-hedgehog/pull/412 [409]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/409 [408]:

@@ -1,4 +1,4 @@-version: 1.1+version: 1.1.1  name:   hedgehog@@ -63,7 +63,7 @@     , erf                             >= 2.0        && < 2.1     , exceptions                      >= 0.7        && < 0.11     , lifted-async                    >= 0.7        && < 0.11-    , mmorph                          >= 1.0        && < 1.2+    , mmorph                          >= 1.0        && < 1.3     , monad-control                   >= 1.0        && < 1.1     , mtl                             >= 2.1        && < 2.3     , pretty-show                     >= 1.6        && < 1.11@@ -143,7 +143,7 @@       hedgehog     , base                            >= 3          && < 5     , containers                      >= 0.4        && < 0.7-    , mmorph                          >= 1.0        && < 1.2+    , mmorph                          >= 1.0        && < 1.3     , mtl                             >= 2.1        && < 2.3     , pretty-show                     >= 1.6        && < 1.11     , text                            >= 1.1        && < 1.3

@@ -9,6 +9,9 @@     UseColor(..)   , resolveColor +  , Seed(..)+  , resolveSeed+   , Verbosity(..)   , resolveVerbosity @@ -17,14 +20,20 @@    , detectMark   , detectColor+  , detectSeed   , detectVerbosity   , detectWorkers   ) where  import           Control.Monad.IO.Class (MonadIO(..)) +import qualified Data.Text as Text+ import qualified GHC.Conc as Conc +import           Hedgehog.Internal.Seed (Seed(..))+import qualified Hedgehog.Internal.Seed as Seed+ import           Language.Haskell.TH.Syntax (Lift)  import           System.Console.ANSI (hSupportsANSI)@@ -107,6 +116,28 @@           else             pure DisableColor +splitOn :: String -> String -> [String]+splitOn needle haystack =+  fmap Text.unpack $ Text.splitOn (Text.pack needle) (Text.pack haystack)++parseSeed :: String -> Maybe Seed+parseSeed env =+  case splitOn " " env of+    [value, gamma] ->+      Seed <$> readMaybe value <*> readMaybe gamma+    _ ->+      Nothing++detectSeed :: MonadIO m => m Seed+detectSeed =+  liftIO $ do+    menv <- lookupEnv "HEDGEHOG_SEED"+    case parseSeed =<< menv of+      Nothing ->+        Seed.random+      Just seed ->+        pure seed+ detectVerbosity :: MonadIO m => m Verbosity detectVerbosity =   liftIO $ do@@ -139,6 +170,13 @@ resolveColor = \case   Nothing ->     detectColor+  Just x ->+    pure x++resolveSeed :: MonadIO m => Maybe Seed -> m Seed+resolveSeed = \case+  Nothing ->+    detectSeed   Just x ->     pure x 

@@ -1248,8 +1248,8 @@ --    prop_with_coverage = --      property $ do --        match <- forAll Gen.bool---        cover 30 "True" $ match---        cover 30 "False" $ not match+--        cover 30 \"True\" $ match+--        cover 30 \"False\" $ not match -- @ -- --   The example above requires a minimum of 30% coverage for both

@@ -63,7 +63,6 @@ import           Hedgehog.Internal.Property (coverPercentage, coverageFailures) import           Hedgehog.Internal.Property (labelCovered) -import           Hedgehog.Internal.Seed (Seed) import           Hedgehog.Internal.Show import           Hedgehog.Internal.Source import           Hedgehog.Range (Size)

@@ -48,7 +48,6 @@ import           Hedgehog.Internal.Queue import           Hedgehog.Internal.Region import           Hedgehog.Internal.Report-import           Hedgehog.Internal.Seed (Seed) import qualified Hedgehog.Internal.Seed as Seed import           Hedgehog.Internal.Tree (TreeT(..), NodeT(..)) import           Hedgehog.Range (Size)@@ -71,6 +70,9 @@       --   the environment.     , runnerColor :: !(Maybe UseColor) +      -- | The seed to use. 'Nothing' means detect from the environment.+    , runnerSeed :: !(Maybe Seed)+       -- | How verbose to be in the runner output. 'Nothing' means detect from       --   the environment.     , runnerVerbosity :: !(Maybe Verbosity)@@ -331,10 +333,11 @@   => Region   -> UseColor   -> Maybe PropertyName+  -> Maybe Seed   -> Property   -> m (Report Result)-checkNamed region color name prop = do-  seed <- liftIO Seed.random+checkNamed region color name mseed prop = do+  seed <- resolveSeed mseed   checkRegion region color name 0 seed prop  -- | Check a property.@@ -343,7 +346,7 @@ check prop = do   color <- detectColor   liftIO . displayRegion $ \region ->-    (== OK) . reportStatus <$> checkNamed region color Nothing prop+    (== OK) . reportStatus <$> checkNamed region color Nothing Nothing prop  -- | Check a property using a specific size and seed. --@@ -373,9 +376,10 @@      putStrLn $ "━━━ " ++ unGroupName group ++ " ━━━" +    seed <- resolveSeed (runnerSeed config)     verbosity <- resolveVerbosity (runnerVerbosity config)     color <- resolveColor (runnerColor config)-    summary <- checkGroupWith n verbosity color props+    summary <- checkGroupWith n verbosity color seed props      pure $       summaryFailed summary == 0 &&@@ -390,9 +394,10 @@      WorkerCount   -> Verbosity   -> UseColor+  -> Seed   -> [(PropertyName, Property)]   -> IO Summary-checkGroupWith n verbosity color props =+checkGroupWith n verbosity color seed props =   displayRegion $ \sregion -> do     svar <- atomically . TVar.newTVar $ mempty { summaryWaiting = PropertyCount (length props) } @@ -430,7 +435,7 @@     summary <-       fmap (mconcat . fmap (fromResult . reportStatus)) $         runTasks n props start finish finalize $ \(name, prop, region) -> do-          result <- checkNamed region color (Just name) prop+          result <- checkNamed region color (Just name) (Just seed) prop           updateSummary sregion svar color             (<> fromResult (reportStatus result))           pure result@@ -463,6 +468,8 @@           Just 1       , runnerColor =           Nothing+      , runnerSeed =+          Nothing       , runnerVerbosity =           Nothing       }@@ -496,6 +503,8 @@         runnerWorkers =           Nothing       , runnerColor =+          Nothing+      , runnerSeed =           Nothing       , runnerVerbosity =           Nothing

@@ -1,5 +1,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveLift #-} -- | -- This is a port of "Fast Splittable Pseudorandom Number Generators" by Steele -- et. al. [1].@@ -61,6 +62,8 @@ import qualified Data.IORef as IORef import           Data.Word (Word32, Word64) +import           Language.Haskell.TH.Syntax (Lift)+ import           System.IO.Unsafe (unsafePerformIO) import           System.Random (RandomGen) import qualified System.Random as Random@@ -71,7 +74,7 @@   Seed {       seedValue :: !Word64     , seedGamma :: !Word64 -- ^ must be an odd number-    } deriving (Eq, Ord)+    } deriving (Eq, Ord, Lift)  instance Show Seed where   showsPrec p (Seed v g) =