hedgehog 1.0.4 → 1.0.5

raw patch · 10 files changed

+135/−36 lines, 10 filesdep ~mmorphdep ~template-haskelldep ~timesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mmorph, template-haskell, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• README.md +2/−2
• Setup.hs +0/−2
• hedgehog.cabal +2/−2
• src/Hedgehog/Internal/Distributive.hs +4/−3
• src/Hedgehog/Internal/Gen.hs +58/−11
• src/Hedgehog/Internal/Shrink.hs +3/−0
• src/Hedgehog/Internal/State.hs +5/−4
• src/Hedgehog/Internal/TH.hs +32/−12
• src/Hedgehog/Internal/Tree.hs +9/−0

@@ -1,3 +1,11 @@+## Version 1.0.5 (2021-03-12)++- GHC 9 Support ([#392][392], [@utdemir][utdemir])+- Use binary shrinking for integral ([#413][413], [@HuwCampbell][HuwCampbell])+- Build tree from values instead of wrapping and unwrapping ([#414][414], [@HuwCampbell][HuwCampbell])+- Don't shrink the action chosen in state machine testing ([#415][415], [@HuwCampbell][HuwCampbell])+- Support shrinking 1-bit numbers for CLaSH ([#397][397], [@jonfowler][jonfowler] / [@jacobstanley][jacobstanley])+ ## Version 1.0.4 (2020-12-11)  - Bump ansi-terminal to 0.11 ([#394][394], [@mpilgrem][mpilgrem])@@ -217,8 +225,16 @@   https://github.com/felixonmars [mpilgrem]:   https://github.com/mpilgrem+[utdemir]:+  https://github.com/utdemir  +[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 [409]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/409 [408]:@@ -229,10 +245,14 @@   https://github.com/hedgehogqa/haskell-hedgehog/pull/405 [398]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/398+[397]:+  https://github.com/hedgehogqa/haskell-hedgehog/pull/397 [396]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/396 [394]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/394+[392]:+  https://github.com/hedgehogqa/haskell-hedgehog/pull/392 [391]:   https://github.com/hedgehogqa/haskell-hedgehog/pull/391 [390]:

@@ -94,8 +94,8 @@  [hackage]: http://hackage.haskell.org/package/hedgehog  [hackage-shield]: https://img.shields.io/hackage/v/hedgehog.svg?style=flat - [travis]: https://travis-ci.org/hedgehogqa/haskell-hedgehog- [travis-shield]: https://travis-ci.org/hedgehogqa/haskell-hedgehog.svg?branch=master+ [travis]: https://travis-ci.com/hedgehogqa/haskell-hedgehog+ [travis-shield]: https://travis-ci.com/hedgehogqa/haskell-hedgehog.svg?branch=master   [appveyor]: https://ci.appveyor.com/project/hedgehogqa/haskell-hedgehog  [appveyor-shield]: https://ci.appveyor.com/api/projects/status/o4rlstbc80sum3on/branch/master?svg=true

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,4 +1,4 @@-version: 1.0.4+version: 1.0.5  name:   hedgehog@@ -69,7 +69,7 @@     , random                          >= 1.1        && < 1.3     , resourcet                       >= 1.1        && < 1.3     , stm                             >= 2.4        && < 2.6-    , template-haskell                >= 2.10       && < 2.17+    , template-haskell                >= 2.10       && < 2.18     , text                            >= 1.1        && < 1.3     , time                            >= 1.4        && < 1.10     , transformers                    >= 0.5        && < 0.6

@@ -22,6 +22,7 @@ import qualified Control.Monad.Trans.Writer.Lazy as Lazy import qualified Control.Monad.Trans.Writer.Strict as Strict +import           Data.Kind (Type) import           GHC.Exts (Constraint)  ------------------------------------------------------------------------@@ -29,9 +30,9 @@  class MonadTransDistributive g where   type Transformer-    (f :: (* -> *) -> * -> *)-    (g :: (* -> *) -> * -> *)-    (m :: * -> *) :: Constraint+    (f :: (Type -> Type) -> Type -> Type)+    (g :: (Type -> Type) -> Type -> Type)+    (m :: Type -> Type) :: Constraint    type Transformer f g m = (       Monad m

@@ -93,6 +93,7 @@   -- ** Choice   , constant   , element+  , element_   , choice   , frequency   , recursive@@ -204,6 +205,7 @@ import           Data.Foldable (for_, toList) import           Data.Functor.Identity (Identity(..)) import           Data.Int (Int8, Int16, Int32, Int64)+import           Data.Kind (Type) import           Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import           Data.Map (Map)@@ -350,7 +352,7 @@ -- | Class of monads which can generate input data for tests. -- class (Monad m, Monad (GenBase m)) => MonadGen m where-  type GenBase m :: (* -> *)+  type GenBase m :: (Type -> Type)    -- | Extract a 'GenT' from a  'MonadGen'.   --@@ -799,24 +801,55 @@ --   > 2058 --   > 2060 ---integral :: (MonadGen m, Integral a) => Range a -> m a+integral :: forall m a. (MonadGen m, Integral a) => Range a -> m a integral range =-  shrink (Shrink.towards $ Range.origin range) (integral_ range)+  -- https://github.com/hedgehogqa/haskell-hedgehog/pull/413/files+  let+    origin_ =+      Range.origin range +    binarySearchTree bottom top =+      Tree.Tree $+        let+          shrinks =+            Shrink.towards bottom top+          children =+            zipWith binarySearchTree shrinks (drop 1 shrinks)+        in+          Tree.NodeT top children++    createTree root =+      if root == origin_ then+        pure root+      else+        hoist Morph.generalize $+          Tree.consChild origin_ $+            binarySearchTree origin_ root++  in+    fromGenT . GenT $ \size seed ->+      createTree $ integralHelper range size seed+ -- | Generates a random integral number in the [inclusive,inclusive] range. -- --   /This generator does not shrink./ -- integral_ :: (MonadGen m, Integral a) => Range a -> m a-integral_ range =-  generate $ \size seed ->-    let-      (x, y) =-        Range.bounds size range-    in-      fromInteger . fst $-        Seed.nextInteger (toInteger x) (toInteger y) seed+integral_ =+  generate . integralHelper ++-- | Generates a random integral value from a range.+integralHelper :: (Integral a, Num c) => Range a -> Size -> Seed -> c+integralHelper range size seed =+  let+    (x, y) =+      Range.bounds size range+  in+    fromInteger . fst $+      Seed.nextInteger (toInteger x) (toInteger y) seed++ -- | Generates a random machine integer in the given @[inclusive,inclusive]@ range. -- --   /This is a specialization of 'integral', offered for convenience./@@ -1152,6 +1185,20 @@     error "Hedgehog.Gen.element: used with empty list"   xs -> do     n <- integral $ Range.constant 0 (length xs - 1)+    pure $ xs !! n++-- | Randomly selects one of the elements in the list.+--+--   This generator does not shrink the choice of element.+--+--   /The input list must be non-empty./+--+element_ :: MonadGen m => [a] -> m a+element_ = \case+  [] ->+    error "Hedgehog.Gen.element: used with empty list"+  xs -> do+    n <- integral_ $ Range.constant 0 (length xs - 1)     pure $ xs !! n  -- | Randomly selects one of the generators in the list.

@@ -27,6 +27,9 @@ towards destination x =   if destination == x then     []+  -- special case for 1-bit numbers+  else if destination == 0 && x == 1 then+    [0]   else     let       -- Halve the operands before subtracting them so they don't overflow.

@@ -65,6 +65,7 @@ import           Data.Foldable (traverse_) import           Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..)) import           Data.Functor.Classes (eq1, compare1, showsPrec1)+import           Data.Kind (Type) import           Data.Map (Map) import qualified Data.Map as Map import qualified Data.Maybe as Maybe@@ -374,7 +375,7 @@ -- an instance of 'MonadTest'. These constraints appear when you pass -- your 'Command' list to 'sequential' or 'parallel'. ---data Command gen m (state :: (* -> *) -> *) =+data Command gen m (state :: (Type -> Type) -> Type) =   forall input output.   (HTraversable input, Show (input Symbolic), Show output, Typeable output) =>   Command {@@ -406,7 +407,7 @@ -- | An instantiation of a 'Command' which can be executed, and its effect --   evaluated. ---data Action m (state :: (* -> *) -> *) =+data Action m (state :: (Type -> Type) -> Type) =   forall input output.   (HTraversable input, Show (input Symbolic), Show output) =>   Action {@@ -541,7 +542,7 @@     Context state0 _ <- get      Command mgenInput exec callbacks <--      Gen.element $ filter (\c -> commandGenOK c state0) commands+      Gen.element_ $ filter (\c -> commandGenOK c state0) commands      input <-       case mgenInput state0 of@@ -578,7 +579,7 @@  -- | A sequence of actions to execute. ---data Sequential m state =+newtype Sequential m state =   Sequential {       -- | The sequence of actions.       sequentialActions :: [Action m state]

@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} module Hedgehog.Internal.TH (@@ -14,11 +15,30 @@ import           Hedgehog.Internal.Discovery import           Hedgehog.Internal.Property -import           Language.Haskell.TH (Exp(..), Q, TExp, location, runIO)-import           Language.Haskell.TH.Syntax (Loc(..), mkName, unTypeQ, unsafeTExpCoerce)+import           Language.Haskell.TH (Exp(..), Q, location, runIO+#if MIN_VERSION_template_haskell(2,17,0)+  , CodeQ, joinCode, unTypeCode, unsafeCodeCoerce+#endif+  )+import           Language.Haskell.TH.Syntax (Loc(..), mkName+#if !MIN_VERSION_template_haskell(2,17,0)+  , TExp, unsafeTExpCoerce, unTypeQ+#endif+  ) -type TExpQ a =-  Q (TExp a)+#if MIN_VERSION_template_haskell(2,17,0)+type TExpQ a = CodeQ a+#else+-- Originally `Code` is a more polymorphic newtype wrapper, but for this module+-- we can get away with just making it a type alias.+type TExpQ a = Q (TExp a)+joinCode :: Q (TExpQ a) -> TExpQ a+joinCode = (>>= id)+unsafeCodeCoerce :: Q Exp -> TExpQ a+unsafeCodeCoerce = unsafeTExpCoerce+unTypeCode ::  TExpQ a -> Q Exp+unTypeCode = unTypeQ+#endif  -- | Discover all the properties in a module. --@@ -28,7 +48,7 @@ discover = discoverPrefix "prop_"  discoverPrefix :: String -> TExpQ Group-discoverPrefix prefix = do+discoverPrefix prefix = joinCode $ do   file <- getCurrentFile   properties <- Map.toList <$> runIO (readProperties prefix file) @@ -44,24 +64,24 @@       fmap (mkNamedProperty . fst) $       List.sortBy startLine properties -  [|| Group $$(moduleName) $$(listTE names) ||]+  return [|| Group $$(moduleName) $$(listTE names) ||]  mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)-mkNamedProperty name = do+mkNamedProperty name =   [|| (name, $$(unsafeProperty name)) ||]  unsafeProperty :: PropertyName -> TExpQ Property unsafeProperty =-  unsafeTExpCoerce . pure . VarE . mkName . unPropertyName+  unsafeCodeCoerce . pure . VarE . mkName . unPropertyName  listTE :: [TExpQ a] -> TExpQ [a]-listTE xs = do-  unsafeTExpCoerce . pure . ListE =<< traverse unTypeQ xs+listTE xs =+  unsafeCodeCoerce $ pure . ListE =<< traverse unTypeCode xs  moduleName :: TExpQ GroupName-moduleName = do+moduleName = joinCode $ do   loc <- GroupName . loc_module <$> location-  [|| loc ||]+  return [|| loc ||]  getCurrentFile :: Q FilePath getCurrentFile =

@@ -40,6 +40,7 @@   , filterMaybeT   , mapMaybeMaybeT   , filterT+  , consChild   , mapMaybeT   , depth   , interleave@@ -315,6 +316,14 @@           NodeT x' (fmap (mapMaybeT p) xs)       Nothing ->         empty++consChild :: (Monad m) => a -> TreeT m a -> TreeT m a+consChild a m =+  TreeT $ do+    NodeT x xs <- runTreeT m+    pure $+      NodeT x $+        pure a : xs  ------------------------------------------------------------------------