hedgehog 0.2.2 → 0.3

raw patch · 10 files changed

+322/−35 lines, 10 filesdep ~mmorphPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mmorph

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−12
• README.md +1/−1
• hedgehog.cabal +3/−2
• src/Hedgehog.hs +9/−3
• src/Hedgehog/Gen.hs +20/−10
• src/Hedgehog/Internal/Distributive.hs +51/−0
• src/Hedgehog/Internal/Property.hs +27/−0
• src/Hedgehog/Internal/Tree.hs +24/−1
• src/Hedgehog/Internal/Tripping.hs +15/−6
• src/Hedgehog/Range.hs +151/−0

@@ -1,20 +1,29 @@+## Version 0.3 (2017-06-11)++- Exponential range combinators (#43, @chris-martin)+- Roundtrip example, check out the [blog post](http://teh.id.au/posts/2017/06/07/round-trip-property/) (#85, @thumphries)+- `tripping` now displays intermediate value (#85, @jystic)+- `distribute` function for pulling a transformer out to the top level (#83, @jystic)+- `withExceptT` function for executing tests with an inner `ExceptT` (e.g. `Test (ExceptT x m) a`) (#83, @jystic)+ ## Version 0.2.2 (2017-05-16) -- Fixed scope of `unicode` character generators.-- Widen version bounds for some dependencies.-- Expose test modules to fix build on nix / hydra.+- Fixed scope of `unicode` character generators (#76, @moodmosaic)+- Widen version bounds for some dependencies (#80, @amarpotghan)+- Expose test modules to fix build on nix / hydra (#78, @amarpotghan)+- Fixes for GHC 8.2 RC2 (#77, @erikd)  ## Version 0.2.1 (2017-05-09) -- Added `ascii`, `latin1`, `unicode` character generators.+- Added `ascii`, `latin1`, `unicode` character generators (#73, @jystic)  ## Version 0.2 (2017-05-06) -- Added a quiet test runner which can be activated by setting `HEDGEHOG_VERBOSITY=0`-- Concurrent test runner does not display tests until they are executing.-- Test runner now outputs a summary of how many successful / failed tests were run.-- `checkSequential` and `checkParallel` now allow for tests to be run without Template Haskell.-- Auto-discovery of properties is now available via `discover` instead of being baked in.-- `annotate` allows source code to be annotated inline with extra information.-- `forAllWith` can be used to generate values without a `Show` instance.-- Removed uses of `Typeable` to allow for generating types which cannot implement it.+- Added a quiet test runner which can be activated by setting `HEDGEHOG_VERBOSITY=0` (@jystic)+- Concurrent test runner does not display tests until they are executing (@jystic)+- Test runner now outputs a summary of how many successful / failed tests were run (@jystic)+- `checkSequential` and `checkParallel` now allow for tests to be run without Template Haskell (@jystic)+- Auto-discovery of properties is now available via `discover` instead of being baked in (@jystic)+- `annotate` allows source code to be annotated inline with extra information (@jystic)+- `forAllWith` can be used to generate values without a `Show` instance (@jystic)+- Removed uses of `Typeable` to allow for generating types which cannot implement it (@jystic)

@@ -74,7 +74,7 @@ ```   [hackage]: http://hackage.haskell.org/package/hedgehog- [hackage-shield]: http://img.shields.io/hackage/v/hedgehog.svg?style=flat+ [hackage-shield]: https://img.shields.io/badge/hackage-v0.3-blue.svg   [travis]: https://travis-ci.org/hedgehogqa/haskell-hedgehog  [travis-shield]: https://travis-ci.org/hedgehogqa/haskell-hedgehog.svg?branch=master

@@ -1,7 +1,7 @@ name:   hedgehog version:-  0.2.2+  0.3 license:   BSD3 author:@@ -54,7 +54,7 @@     , containers                      >= 0.4        && < 0.6     , directory                       >= 1.2        && < 1.4     , exceptions                      >= 0.7        && < 0.9-    , mmorph                          >= 1.0        && < 1.1+    , mmorph                          >= 1.0        && < 1.2     , mtl                             >= 2.1        && < 2.3     , pretty-show                     >= 1.6        && < 1.7     , primitive                       >= 0.6        && < 0.7@@ -90,6 +90,7 @@      Hedgehog.Internal.Config     Hedgehog.Internal.Discovery+    Hedgehog.Internal.Distributive     Hedgehog.Internal.Property     Hedgehog.Internal.Queue     Hedgehog.Internal.Region

@@ -84,23 +84,29 @@    , liftEither   , liftExceptT+  , withExceptT   , withResourceT    , tripping++  -- * Transformers+  , distribute   ) where  import           Hedgehog.Gen (Gen)+import           Hedgehog.Internal.Distributive (distribute)+import           Hedgehog.Internal.Property (annotate, annotateShow) import           Hedgehog.Internal.Property (assert, (===)) import           Hedgehog.Internal.Property (discard, failure, success) import           Hedgehog.Internal.Property (DiscardLimit, withDiscards)-import           Hedgehog.Internal.Property (forAll, forAllWith)-import           Hedgehog.Internal.Property (annotate, annotateShow) import           Hedgehog.Internal.Property (footnote, footnoteShow)-import           Hedgehog.Internal.Property (liftEither, liftExceptT, withResourceT)+import           Hedgehog.Internal.Property (forAll, forAllWith)+import           Hedgehog.Internal.Property (liftEither, liftExceptT) import           Hedgehog.Internal.Property (Property, PropertyName, Group(..), GroupName) import           Hedgehog.Internal.Property (ShrinkLimit, withShrinks) import           Hedgehog.Internal.Property (Test, property) import           Hedgehog.Internal.Property (TestLimit, withTests)+import           Hedgehog.Internal.Property (withExceptT, withResourceT) import           Hedgehog.Internal.Runner (check, recheck, checkSequential, checkParallel) import           Hedgehog.Internal.Seed (Seed(..)) import           Hedgehog.Internal.TH (discover)

@@ -145,7 +145,7 @@   ) where  import           Control.Applicative (Alternative(..))-import           Control.Monad (MonadPlus(..), mfilter, filterM, replicateM, ap)+import           Control.Monad (MonadPlus(..), mfilter, filterM, replicateM, ap, join) import           Control.Monad.Base (MonadBase(..)) import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..)) import           Control.Monad.Error.Class (MonadError(..))@@ -178,6 +178,7 @@ import qualified Data.Text.Encoding as Text import           Data.Word (Word8, Word16, Word32, Word64) +import           Hedgehog.Internal.Distributive (Distributive(..)) import           Hedgehog.Internal.Seed (Seed) import qualified Hedgehog.Internal.Seed as Seed import qualified Hedgehog.Internal.Shrink as Shrink@@ -233,7 +234,7 @@       Nothing ->         mzero       Just (Node x xs) ->-        pure (x, liftTree . Tree . pure $ Node x xs)+        pure (x, liftTree . Tree.fromNode $ Node x xs)  -- | Lift a predefined shrink tree in to a generator, ignoring the seed and the --   size.@@ -246,14 +247,8 @@ --   at the nodes. 'Nothing' means discarded, 'Just' means we have a value. -- runDiscardEffect :: Monad m => Tree (MaybeT m) a -> Tree m (Maybe a)-runDiscardEffect s =-  Tree $ do-    mx <- runMaybeT $ runTree s-    case mx of-      Nothing ->-        pure $ Node Nothing []-      Just (Node x xs) ->-        pure $ Node (Just x) (fmap runDiscardEffect xs)+runDiscardEffect =+  runMaybeT . distribute  ------------------------------------------------------------------------ -- Gen instances@@ -330,6 +325,21 @@ instance MMonad Gen where   embed =     embedGen++distributeGen :: Transformer t Gen m => Gen (t m) a -> t (Gen m) a+distributeGen x =+  join . lift . Gen $ \size seed ->+    pure . hoist liftTree . distribute . hoist distribute $ runGen size seed x++instance Distributive Gen where+  type Transformer t Gen m = (+      Monad (t (Gen m))+    , Transformer t MaybeT m+    , Transformer t Tree (MaybeT m)+    )++  distribute =+    distributeGen  instance PrimMonad m => PrimMonad (Gen m) where   type PrimState (Gen m) =

@@ -0,0 +1,51 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}+module Hedgehog.Internal.Distributive (+    Distributive(..)+  ) where++import           Control.Monad (join)+import           Control.Monad.Morph (MFunctor(..))+import           Control.Monad.Trans.Class (MonadTrans(..))+import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)+import           Control.Monad.Trans.Maybe (MaybeT(..))+import           Control.Monad.Trans.Reader (ReaderT(..))+import           Control.Monad.Trans.Writer (WriterT(..))++import           GHC.Exts (Constraint)+++class Distributive g where+  type Transformer+    (f :: (* -> *) -> * -> *)+    (g :: (* -> *) -> * -> *)+    (m :: * -> *) :: Constraint++  type Transformer f g m = (+        Monad m+      , Monad (f m)+      , Monad (g m)+      , Monad (f (g m))+      , MonadTrans f+      , MFunctor f+      )++  distribute :: Transformer f g m => g (f m) a -> f (g m) a++instance Distributive MaybeT where+  distribute x =+    lift . MaybeT . pure =<< hoist lift (runMaybeT x)++instance Distributive (ExceptT x) where+  distribute x =+    lift . ExceptT . pure =<< hoist lift (runExceptT x)++instance Monoid w => Distributive (WriterT w) where+  distribute x =+    lift . WriterT . pure =<< hoist lift (runWriterT x)++instance Distributive (ReaderT r) where+  distribute x =+    join . lift . ReaderT $ \r ->+      pure . hoist lift $ runReaderT x r

@@ -48,6 +48,7 @@    , liftEither   , liftExceptT+  , withExceptT   , withResourceT    -- * Internal@@ -81,6 +82,7 @@  import           Hedgehog.Gen (Gen) import qualified Hedgehog.Gen as Gen+import           Hedgehog.Internal.Distributive import           Hedgehog.Internal.Show import           Hedgehog.Internal.Source @@ -219,6 +221,24 @@   hoist f =     Test . hoist (hoist (hoist f)) . unTest +distributeTest :: Transformer t Test m => Test (t m) a -> t (Test m) a+distributeTest =+  hoist Test .+  distribute .+  hoist distribute .+  hoist (hoist distribute) .+  unTest++instance Distributive Test where+  type Transformer t Test m = (+      Transformer t Gen m+    , Transformer t (WriterT [Log]) (Gen m)+    , Transformer t (ExceptT Failure) (WriterT [Log] (Gen m))+    )++  distribute =+    distributeTest+ instance PrimMonad m => PrimMonad (Test m) where   type PrimState (Test m) =     PrimState m@@ -448,6 +468,13 @@ liftExceptT :: (Monad m, Show x, HasCallStack) => ExceptT x m a -> Test m a liftExceptT m =   withFrozenCallStack liftEither =<< lift (runExceptT m)++-- | Fails the test if the 'ExceptT' is 'Left', otherwise returns the value in+--   the 'Right'.+--+withExceptT :: (Monad m, Show x, HasCallStack) => Test (ExceptT x m) a -> Test m a+withExceptT m =+  withFrozenCallStack liftEither =<< runExceptT (distribute m)  -- | Run a computation which requires resource acquisition / release. --

@@ -9,6 +9,8 @@     Tree(..)   , Node(..) +  , fromNode+   , unfold   , unfoldForest @@ -19,7 +21,7 @@   ) where  import           Control.Applicative (Alternative(..))-import           Control.Monad (MonadPlus(..), ap)+import           Control.Monad (MonadPlus(..), ap, join) import           Control.Monad.Base (MonadBase(..)) import           Control.Monad.Catch (MonadThrow(..), MonadCatch(..), Exception) import           Control.Monad.Error.Class (MonadError(..))@@ -37,6 +39,8 @@ import           Data.Functor.Classes (showsUnaryWith, showsBinaryWith) #endif +import           Hedgehog.Internal.Distributive+ ------------------------------------------------------------------------  -- | An effectful tree, each node in the tree can have an effect before it is@@ -55,6 +59,12 @@     , nodeChildren :: [Tree m a]     } +-- | Create a 'Tree' from a 'Node'+--+fromNode :: Applicative m => Node m a -> Tree m a+fromNode =+  Tree . pure+ -- | Create a tree from a value and an unfolding function. -- unfold :: Monad m => (a -> [a]) -> a -> Tree m a@@ -166,6 +176,19 @@ instance MMonad Tree where   embed f m =     embedTree f m++distributeNode :: Transformer t Tree m => Node (t m) a -> t (Tree m) a+distributeNode (Node x xs) =+  join . lift . fromNode . Node (pure x) $+    fmap (pure . distributeTree) xs++distributeTree :: Transformer t Tree m => Tree (t m) a -> t (Tree m) a+distributeTree x =+  distributeNode =<< hoist lift (runTree x)++instance Distributive Tree where+  distribute =+    distributeTree  instance PrimMonad m => PrimMonad (Tree m) where   type PrimState (Tree m) =

@@ -7,25 +7,29 @@ import           Hedgehog.Internal.Source  --- | Test that a pair of render / parse functions are compatible.+-- | Test that a pair of encode / decode functions are compatible. -- tripping ::      HasCallStack   => Applicative f   => Monad m+  => Show b   => Show (f a)   => Eq (f a)   => a   -> (a -> b)   -> (b -> f a)   -> Test m ()-tripping x render parse =+tripping x encode decode =   let     mx =       pure x +    i =+      encode x+     my =-      (parse . render) x+      decode i   in     if mx == my then       success@@ -36,12 +40,17 @@             failWith Nothing $ unlines [                 "━━━ Original ━━━"               , showPretty mx+              , "━━━ Intermediate ━━━"+              , showPretty i               , "━━━ Roundtrip ━━━"               , showPretty my               ]          Just diff ->           withFrozenCallStack $-              failWith-                (Just $ Diff "Failed (" "- Original" "/" "+ Roundtrip" ")" diff)-                ""+            failWith+              (Just $ Diff "━━━ " "- Original" "/" "+ Roundtrip" " ━━━" diff) $+              unlines [+                  "━━━ Intermediate ━━━"+                , showPretty i+                ]

@@ -23,11 +23,20 @@   , linearFracFrom   , linearBounded +  -- * Exponential+  , exponential+  , exponentialFrom+  , exponentialBounded+  , exponentialFloat+  , exponentialFloatFrom+   -- * Internal   -- $internal   , clamp   , scaleLinear   , scaleLinearFrac+  , scaleExponential+  , scaleExponentialFloat   ) where  import           Data.Bifunctor (bimap)@@ -299,6 +308,148 @@       (n - z) * (fromIntegral sz / 99)   in     z + diff++-- | Construct a range which scales the second bound exponentially relative to+--   the size parameter.+--+--   >>> bounds 0 $ exponential 1 512+--   (1,1)+--+--   >>> bounds 11 $ exponential 1 512+--   (1,2)+--+--   >>> bounds 22 $ exponential 1 512+--   (1,4)+--+--   >>> bounds 77 $ exponential 1 512+--   (1,128)+--+--   >>> bounds 88 $ exponential 1 512+--   (1,256)+--+--   >>> bounds 99 $ exponential 1 512+--   (1,512)+--+exponential :: Integral a => a -> a -> Range a+exponential x y =+  exponentialFrom x x y++-- | Construct a range which scales the bounds exponentially relative to the+-- size parameter.+--+--   >>> bounds 0 $ exponentialFrom 0 (-128) 512+--   (0,0)+--+--   >>> bounds 25 $ exponentialFrom 0 (-128) 512+--   (-2,4)+--+--   >>> bounds 50 $ exponentialFrom 0 (-128) 512+--   (-11,22)+--+--   >>> bounds 75 $ exponentialFrom 0 (-128) 512+--   (-39,112)+--+--   >>> bounds 99 $ exponentialFrom x (-128) 512+--   (-128,512)+--+exponentialFrom :: Integral a => a -> a -> a -> Range a+exponentialFrom z x y =+  Range z $ \sz ->+    let+      sized_x =+        clamp x y $ scaleExponential sz z x++      sized_y =+        clamp x y $ scaleExponential sz z y+    in+      (sized_x, sized_y)++-- | Construct a range which is scaled exponentially relative to the size+--   parameter and uses the full range of a data type.+--+--   >>> bounds 0 (exponentialBounded :: Range Int8)+--   (0,0)+--+--   >>> bounds 50 (exponentialBounded :: Range Int8)+--   (-11,11)+--+--   >>> bounds 99 (exponentialBounded :: Range Int8)+--   (-128,127)+--+exponentialBounded :: (Bounded a, Integral a) => Range a+exponentialBounded =+  exponentialFrom 0 minBound maxBound++-- | Construct a range which scales the second bound exponentially relative to+--   the size parameter.+--+--   This works the same as 'exponential', but for floating-point values.+--+--   >>> bounds 0 $ exponentialFloat 0 10+--   (0.0,0.0)+--+--   >>> bounds 50 $ exponentialFloat 0 10+--   (0.0,2.357035250656098)+--+--   >>> bounds 99 $ exponentialFloat 0 10+--   (0.0,10.0)+--+exponentialFloat :: (Floating a, Ord a) => a -> a -> Range a+exponentialFloat x y =+  exponentialFloatFrom x x y++-- | Construct a range which scales the bounds exponentially relative to the+--   size parameter.+--+--   This works the same as 'exponentialFrom', but for floating-point values.+--+--   >>> bounds 0 $ exponentialFloatFrom 0 (-10) 20+--   (0.0,0.0)+--+--   >>> bounds 50 $ exponentialFloatFrom 0 (-10) 20+--   (-2.357035250656098,3.6535836249197002)+--+--   >>> bounds 99 $ exponentialFloatFrom x (-10) 20+--   (-10.0,20.0)+--+exponentialFloatFrom :: (Floating a, Ord a) => a -> a -> a -> Range a+exponentialFloatFrom z x y =+  Range z $ \sz ->+    let+      sized_x =+        clamp x y $ scaleExponentialFloat sz z x++      sized_y =+        clamp x y $ scaleExponentialFloat sz z y+    in+      (sized_x, sized_y)++-- | Scale an integral exponentially with the size parameter.+--+scaleExponential :: Integral a => Size -> a -> a -> a+scaleExponential sz z0 n0 =+  let+    z =+      fromIntegral z0++    n =+      fromIntegral n0+  in+    round (scaleExponentialFloat sz z n :: Double)++-- | Scale a floating-point number exponentially with the size parameter.+--+scaleExponentialFloat :: Floating a => Size -> a -> a -> a+scaleExponentialFloat sz0 z n =+  let+    sz =+      clamp 0 99 sz0++    diff =+      (((abs (n - z) + 1) ** (realToFrac sz / 99)) - 1) * signum (n - z)+  in+    z + diff+  ------------------------------------------------------------------------ -- Internal