quickcheck-silent 0.11.0.16 → 0.11.0.17

raw patch · 3 files changed

+75/−27 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• quickcheck-silent.cabal +1/−1
• src/Test/QuickCheck/Silent.hs +68/−26

@@ -1,5 +1,11 @@ # Revision history for quickcheck-silent +## 0.11.0.17 -- 2026-09-23++* Added a `Timeout` to: `quickCheckSilent`, `quickCheckSilentSuite` and+  `quickCheckSilentSuiteJSON` to provide an upper bound to avoid non-terminating+  computations in test cases.+ ## 0.11.0.16 -- 2026-08-20  * Updated `quickCheckSilentSuiteJSON` documentation.

@@ -10,7 +10,7 @@ build-type: Simple                                                name: quickcheck-silent-version: 0.11.0.16+version: 0.11.0.17  synopsis: Testing with QuickCheck in silence description: Testing with QuickCheck in silence. For more info see README.md

@@ -5,6 +5,10 @@  {-# LANGUAGE DeriveDataTypeable           #-} +{-# LANGUAGE LambdaCase                   #-}++{-# LANGUAGE NumericUnderscores           #-}+ --------------------------------------------------------------------------------  -- |@@ -27,6 +31,9 @@   , silent   , withNumTests     -- * Running tests+  , Timeout+  , Separator+  , Pattern   , Status(..)   , Result(..)   , JSON@@ -41,6 +48,8 @@  import           Data.Data                            ( Data ) import           Data.List                            ( isPrefixOf )+import           Data.Maybe                           ( fromMaybe )+import           System.Timeout                       ( timeout )  import qualified Test.QuickCheck                      as QC import           Test.QuickCheck@@ -63,18 +72,29 @@  -------------------------------------------------------------------------------- --- | A name or description for a case or a subtree of the @Test@s.+-- | A name or description for a case or a subtree of the 'Test's. type Label = String  -- | The basic structure used to create an annotated tree of test cases. data Test-  -- | A set of @Test@s sharing the same level in the hierarchy.+  -- | A set of 'Test's sharing the same level in the hierarchy.   = Group !Label ![Test]   -- | A single, independent test case composed.   | Case  !Label !SilentProp  -------------------------------------------------------------------------------- +-- | To ensure a computation result is available within @n@ seconds.+type Timeout = Int++-- | A character, for example: @.@ (dot), that separates 'Test' 'Label's for+-- 'Group's and 'Case's.+type Separator = Char++-- | A string containing 'Test' 'Label's for 'Group's and 'Case's as well as the+-- chosen 'Separator' character. For example: @"Test.QuickCheck.Silent"@.+type Pattern = String+ -- | Status represents the outcome of a test data Status   -- | A successful test run@@ -156,25 +176,38 @@  -------------------------------------------------------------------------------- --- | Tests a sequence of silent properties, producing a list of results, without--- printing them to 'System.IO.stdout'.+-- | Tests a sequence of silent properties, producing a list of 'Result's,+-- without printing them to 'System.IO.stdout', in case 'Result's are available+-- before the 'Timeout' (seconds) expires. If no 'Timeout' value is provided, a+-- default value of @60@ seconds will be used. If a computation timed-out, an+-- empty list will be provided. quickCheckSilent-  :: [SilentProp]+  :: Maybe Timeout+  -> [SilentProp]   -> IO [Result]-quickCheckSilent =-  mapM (\ p -> resultAux <$> (aux . property) p)+quickCheckSilent mto sps =+  ( \ case+      Just rs -> rs+      Nothing -> []+  )+  <$> timeout oto (mapM (\ p -> resultAux <$> (aux . property) p) sps)   where+    oto = 1_000_000 * fromMaybe 60 mto     aux =       QC.quickCheckWithResult $ stdArgs { chatty = False } --- | Tests a suite of silent properties, producing a list of results with their--- respective labels and without printing them to 'System.IO.stdout'.+-- | Tests a suite of silent properties, producing a list of 'Result's with+-- their respective 'Label's and without printing them to 'System.IO.stdout', in+-- case 'Result's are available before the 'Timeout' (seconds) expires. If no+-- 'Timeout' value is provided, a default value of @60@ seconds will be used. If+-- a computation timed-out, an empty list will be provided. -- -- For example, -- -- > check =--- >   quickCheckSilentSuite sep pts tcs+-- >   quickCheckSilentSuite oto sep pts tcs -- >   where+-- >     oto = Just 60 -- seconds -- >     sep = '.' -- >     pts = [ "Test.QuickCheck.Silent" ] -- >     tcs =@@ -192,27 +225,35 @@ -- -- will test both @p@ and @q@, but not @r@. ----- The provided @patterns@, will be checked if they are a 'Data.List.isPrefixOf'--- of each @label@:+-- The provided 'Pattern's, will be checked if they are a 'Data.List.isPrefixOf'+-- of each 'Label': -- -- > any (`isPrefixOf` label) [ pattern_0, pattern_1, … pattern_n ] -- -- @NOTE@: To test all cases, just provide a singleton list with an empty string--- element as @pattern@ as it's a prefix for all possible @labels@.+-- element as 'Pattern's as it's a prefix for all possible 'Label's. quickCheckSilentSuite-  :: Char-  -> [String]+  :: Maybe Timeout+  -> Separator+  -> [Pattern]   -> Test   -> IO [(Label, Result)]-quickCheckSilentSuite sep pts suite =-  mapM-    ( \ (l, sp) ->-        (aux . property) sp >>= \ r ->-        pure (l, resultAux r)+quickCheckSilentSuite mto sep pts suite =+  ( \ case+      Just rs -> rs+      Nothing -> []+  )+  <$> timeout oto+    ( mapM+        ( \ (l, sp) ->+            (aux . property) sp >>= \ r ->+            pure (l, resultAux r)+        )+      $ filter ( \(l, _) -> any  (`isPrefixOf` l) pts)+      $ dfs [] suite     )-  $ filter ( \(l, _) -> any  (`isPrefixOf` l) pts)-  $ dfs [] suite   where+    oto = 1_000_000 * fromMaybe 60 mto     dfs [ ] (Group l ts) = concatMap (dfs                  l)  ts     dfs acc (Group l ts) = concatMap (dfs (acc ++ [sep] ++ l)) ts     dfs [ ] (Case  l p)  = [              (                l, p)]@@ -223,16 +264,17 @@ -- | Same behavior as 'quickCheckSilentSuite', but, producing a list of 'JSON' -- data payloads instead. quickCheckSilentSuiteJSON-  :: Char-  -> [String]+  :: Maybe Timeout+  -> Separator+  -> [Pattern]   -> Test   -> IO [JSON]-quickCheckSilentSuiteJSON sep pts suite =+quickCheckSilentSuiteJSON mto sep pts suite =   map   ( \ (l, r) ->       encodeJSON $ LabelResultJSON l r   )-  <$> quickCheckSilentSuite sep pts suite+  <$> quickCheckSilentSuite mto sep pts suite  -- | Check if the test run result was a success isSuccess :: Result -> Bool