hspec-hedgehog-0.0.1.2/src/0000755000000000000000000000000013627320523013502 5ustar0000000000000000hspec-hedgehog-0.0.1.2/src/Test/0000755000000000000000000000000013627320467014430 5ustar0000000000000000hspec-hedgehog-0.0.1.2/src/Test/Hspec/0000755000000000000000000000000013645160177015472 5ustar0000000000000000hspec-hedgehog-0.0.1.2/test/0000755000000000000000000000000013645160177013701 5ustar0000000000000000hspec-hedgehog-0.0.1.2/src/Test/Hspec/Hedgehog.hs0000644000000000000000000002032713645160177017544 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module allows you to easily integrate the "Hedgehog" library with -- "Test.Hspec" test-suites. -- -- To get started, check out the 'hedgehog' function, which lets you embed -- a 'PropertyT' directly. -- -- @ -- spec :: 'Spec' -- spec = -- 'describe' \"my great test\" '$' do -- 'it' \"generates stuff\" '$' -- 'hedgehog' '$' do -- a <- 'forAll' generator -- a '===' expected -- @ -- -- Truth be told, the functionality is in the two orphan instances of -- 'Example' for 'PropertyT'. You can directly use code in the @'PropertyT' -- 'IO'@ type. However, because most "Hedgehog" functions are abstract in -- 'MonadTest', you might get errors about ambiguous types. The 'hedgehog' -- function fixes the type to @'PropertyT' 'IO' '()'@, which works out just -- fine. -- -- You can use all of @hspec@'s hooks with this, of course. -- -- @ -- spec :: Spec -- spec = 'before' ('pure' \"Hello!\") '$' do -- 'describe' \"with a string\" '$' do -- 'it' \"gets a string\" '$' \\ str -> -- 'hedgehog' '$' do -- wrongLen <- 'forAll' $ 'Gen.integral' ('Range.linear' 0 3) -- length str '/==' wrongLen -- @ -- -- The function 'before' will make all the following spec items a function, -- accepting that as a parameter. You should call 'hedgehog' after the -- lambda. -- -- If you are morally opposed to the pattern: -- -- @ -- 'it' \"message\" $ 'hedgehog' $ do -- True '===' False -- @ -- -- Then you can alternatively force the type some other way. One option is -- to use a no-op function, like this: -- -- @ -- 'it' \"message\" $ do -- 'pure' () :: 'PropertyT' 'IO' () -- True '===' False -- @ -- -- This style has the advantage that parameters via hooks are less -- difficult to get right. -- -- @ -- 'before' ('pure' \"Hello!\") $ do -- 'it' \"message\" $ \\str -> do -- 'pure' () :: 'PropertyT' 'IO' () -- wrongLen <- 'forAll' $ 'Gen.integral' ('Range.linear' 0 3) -- 'length' str '/==' wrongLen -- @ -- -- You don't have to remember to put the 'hedgehog' call after the lambda. module Test.Hspec.Hedgehog ( -- * The Main Function hedgehog -- * Hspec re-exports , modifyArgs , modifyMaxSuccess , modifyMaxDiscardRatio , modifyMaxSize , modifyMaxShrinks -- * Hedgehog Re-exports , module Hedgehog ) where import Control.Monad.IO.Class (liftIO) import Data.Coerce (coerce) import Data.IORef (newIORef, readIORef, writeIORef) import Hedgehog import Hedgehog.Internal.Config (detectColor) import Hedgehog.Internal.Property (DiscardLimit (..), Property (..), PropertyConfig (..), ShrinkLimit (..), TerminationCriteria (..), TestCount (..), TestLimit (..)) import Hedgehog.Internal.Report as Hedge import Hedgehog.Internal.Runner (checkReport) import qualified Hedgehog.Internal.Seed as Seed import Hedgehog.Internal.Source (ColumnNo (..), LineNo (..), Span (..)) import System.Random.SplitMix (unseedSMGen) import Test.Hspec import Test.Hspec.Core.Spec as Hspec import Test.Hspec.QuickCheck (modifyArgs, modifyMaxDiscardRatio, modifyMaxShrinks, modifyMaxSize, modifyMaxSuccess) import Test.HUnit.Base (assertFailure) import Test.QuickCheck.Random (QCGen (..)) import Test.QuickCheck.Test (Args (..)) -- | Embed a "Hedgehog" @'PropertyT' 'IO' ()@ in an @hspec@ test. -- -- @ -- spec :: 'Spec' -- spec = -- 'describe' \"my great test\" '$' do -- 'it' \"generates stuff\" '$' -- 'hedgehog' '$' do -- a <- 'forAll' generator -- a '===' expected -- @ -- -- This function is only used to fix the type of the @'PropertyT'@ monad -- transformer. The functions in "Hedgehog" are typically abstract in -- a 'MonadTest', and it's easy to get ambiguous type errors if you leave -- this out. -- -- @since 0.0.0.0 hedgehog :: HasCallStack => PropertyT IO () -> PropertyT IO () hedgehog = id -- | Warning: Orphan instance! This instance is used to embed a "Hedgehog" -- property seamlessly into the @hspec@ framework. See the other instance -- of 'Example' for a function for more details. -- -- @since 0.0.0.0 instance Example (PropertyT IO ()) where type Arg (PropertyT IO ()) = () evaluateExample e = evaluateExample (\() -> e) -- | Warning: orphan instance! This instance is used to embed a "Hedgehog" -- property seamlessly into the @hspec@ framework. -- -- The instance will pick things up from the "Test.Hspec.QuickCheck" -- configuration. For example, if the program is supposed to use -- a predetermined seed, then the same seed will be used for QuickCheck and -- Hedgehog tests. -- -- @since 0.0.0.0 instance Example (a -> PropertyT IO ()) where type Arg (a -> PropertyT IO ()) = a evaluateExample (fmap property -> aprop) params aroundAction progressCallback = do ref <- newIORef (Result "" (Pending Nothing Nothing)) aroundAction $ \a -> do color <- detectColor let size = 0 prop = aprop a propConfig = useQuickCheckArgs (propertyConfig prop) qcArgs = paramsQuickCheckArgs params maxTests = maxSuccess qcArgs useQuickCheckArgs pc = pc { propertyTerminationCriteria = case propertyTerminationCriteria pc of EarlyTermination x (TestLimit _) -> EarlyTermination x (TestLimit maxTests) NoEarlyTermination x (TestLimit _) -> NoEarlyTermination x (TestLimit maxTests) NoConfidenceTermination (TestLimit _) -> NoConfidenceTermination (TestLimit maxTests) , propertyDiscardLimit = DiscardLimit $ maxDiscardRatio qcArgs , propertyShrinkLimit = ShrinkLimit $ maxShrinks qcArgs } testCount report = case reportTests report of TestCount n -> n cb progress = do case reportStatus progress of Running -> progressCallback (testCount progress, maxTests) Shrinking _ -> progressCallback (testCount progress, maxTests) seed <- liftIO $ case replay (paramsQuickCheckArgs params) of Nothing -> Seed.random Just (rng, _) -> pure (uncurry Seed (unseedSMGen (coerce rng))) hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb ppresult <- renderResult color Nothing hedgeResult writeIORef ref $ Result "" $ case reportStatus hedgeResult of Failed FailureReport{..} -> let fromSpan Span{..} = Location { locationFile = spanFile , locationLine = coerce spanStartLine , locationColumn = coerce spanStartColumn } in Hspec.Failure (fromSpan <$> failureLocation) $ Reason ppresult GaveUp -> Failure Nothing (Reason "GaveUp") OK -> Success readIORef ref hspec-hedgehog-0.0.1.2/test/Spec.hs0000644000000000000000000000417613645160177015137 0ustar0000000000000000import Control.Concurrent (threadDelay) import Control.Monad.IO.Class (liftIO) import Data.IORef (atomicModifyIORef', readIORef, newIORef) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Hspec (before, beforeAll, describe, hspec, it, shouldBe) import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog, (/==), (===)) import Test.Hspec.QuickCheck (modifyMaxSuccess) main :: IO () main = hspec $ do describe "regular tests" $ do it "works" $ do True `shouldBe` True describe "hedgehog" $ do it "is useful if you get an ambiguous error" $ hedgehog $ do "no ambiguity" === "no ambiguity" describe "hedgehog tests" $ do it "lets you use PropertyT directly" $ hedgehog $ do x <- forAll $ Gen.integral (Range.linear 0 1000) y <- forAll $ Gen.integral (Range.linear 0 5000) diff (x + y) (>=) (x :: Integer) it "renders a progress bit" $ hedgehog $ do x <- forAll $ Gen.integral (Range.linear 0 1000) y <- forAll $ Gen.integral (Range.linear 1 5000) liftIO $ threadDelay (100 * x + y) describe "with hooks" $ do before (pure "Hello!") $ do it "has functions" $ \str -> hedgehog $ str === "Hello!" it "goes before or after" $ \str -> do pure () :: PropertyT IO () str === "Hello!" it "generates" $ \str -> hedgehog $ do wrongLen <- forAll $ Gen.integral (Range.linear 0 3) length str /== wrongLen describe "modifyMaxSuccess" $ do modifyMaxSuccess (\_ -> 10) $ do beforeAll (newIORef (0 :: Integer)) $ do it "counts to 10" $ \ref -> hedgehog $ do liftIO $ atomicModifyIORef' ref (\a -> (a + 1, ())) True === True it "works" $ \ref -> do val <- readIORef ref val `shouldBe` 10 hspec-hedgehog-0.0.1.2/LICENSE0000644000000000000000000000277113627320317013730 0ustar0000000000000000Copyright Author name here (c) 2020 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hspec-hedgehog-0.0.1.2/Setup.hs0000644000000000000000000000005613627320317014351 0ustar0000000000000000import Distribution.Simple main = defaultMain hspec-hedgehog-0.0.1.2/hspec-hedgehog.cabal0000644000000000000000000000257513645160177016571 0ustar0000000000000000cabal-version: 1.12 name: hspec-hedgehog version: 0.0.1.2 description: Please see the README on GitHub at synopsis: Integrate Hedgehog and Hspec! category: Testing homepage: https://github.com/parsonsmatt/hspec-hedgehog#readme bug-reports: https://github.com/parsonsmatt/hspec-hedgehog/issues author: Matt Parsons maintainer: parsonsmatt@gmail.com copyright: 2020 Matt Parsons license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md source-repository head type: git location: https://github.com/parsonsmatt/hspec-hedgehog library exposed-modules: Test.Hspec.Hedgehog hs-source-dirs: src build-depends: base >= 4.7 && < 5 , hspec >= 2.4.4 && < 3 , hspec-core >= 2.4.4 && < 3 , hedgehog >= 1.0.2 && < 2 , HUnit >= 1.5 && < 2 , QuickCheck >= 2.9.2 && < 3 , splitmix >= 0.0.1 && < 1 default-language: Haskell2010 test-suite hspec-hedgehog-test type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.7 && < 5 , hspec-hedgehog , hspec , hedgehog >= 1.0.2 && < 2 default-language: Haskell2010 hspec-hedgehog-0.0.1.2/README.md0000644000000000000000000000571513627520237014206 0ustar0000000000000000# hspec-hedgehog [![Build Status](https://travis-ci.org/parsonsmatt/hspec-hedgehog.svg?branch=master)](https://travis-ci.org/parsonsmatt/hspec-hedgehog) An integration library for [hspec](https://hackage.haskell.org/package/hspec) and [hedgehog](https://hackage.haskell.org/package/hedgehog). Example: ```haskell import Control.Concurrent (threadDelay) import Control.Monad.IO.Class (liftIO) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Hspec (before, describe, hspec, it, shouldBe) import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog, (/==), (===)) main :: IO () main = hspec $ do describe "regular tests" $ do it "works" $ do True `shouldBe` True describe "hedgehog" $ do it "is useful if you get an ambiguous error" $ hedgehog $ do "no ambiguity" === "no ambiguity" describe "hedgehog tests" $ do it "lets you use PropertyT directly" $ hedgehog $ do x <- forAll $ Gen.integral (Range.linear 0 1000) y <- forAll $ Gen.integral (Range.linear 0 5000) diff (x + y) (>=) x it "renders a progress bit" $ hedgehog $ do x <- forAll $ Gen.integral (Range.linear 0 1000) y <- forAll $ Gen.integral (Range.linear 1 5000) liftIO $ threadDelay (100 * x + y) describe "with hooks" $ do before (pure "Hello!") $ do it "has functions" $ \str -> hedgehog $ str === "Hello!" it "goes before or after" $ \str -> do pure () :: PropertyT IO () str === "Hello!" it "generates" $ \str -> hedgehog $ do wrongLen <- forAll $ Gen.integral (Range.linear 0 3) length str /== wrongLen ``` ## How does this differ from [`hw-hspec-hedgehog`](https://hackage.haskell.org/package/hw-hspec-hedgehog)? Good question! The `hw-spec-hedgehog` implementation does the easy thing. It calls Hedgehog's `check` function on the property, and if the property returns `True`, then it passes the test. If the property fails, then it renders an [uninformative failure message](https://twitter.com/mattoflambda/status/1234879820225400832) - it's hardcoded to be: > Hedgehog property test failed And that's all you get! This library preserves Hedgehog's error message formatting, so you get [rich, insightful error messages](https://twitter.com/mattoflambda/status/1234880271406661633) just like Hedgehog intended. Furthermore, this library integrates with `hspec`'s support for the `QuickCheck` library. Any option that works with `QuickCheck` should work with `hedgehog` properties, so you can use `modifyMaxSuccess (\_ -> 10)` to set the total tests to be 10, rather than the default 100. Because it integrates directly with hspec, it also renders a familiar progress message while the test is running. hspec-hedgehog-0.0.1.2/ChangeLog.md0000644000000000000000000000142013645160177015070 0ustar0000000000000000# Changelog for hspec-hedgehog ## 0.0.1.2 - [#7](https://github.com/parsonsmatt/hspec-hedgehog/pull/7) @parsonsmatt - Handle error states better by returning them in the instance rather than throwing an exception. - [#6](https://github.com/parsonsmatt/hspec-hedgehog/pull/6) @jezen - Bump lower bound on `hedgehog` to fix the build constraints. ## 0.0.1.1 - [#2](https://github.com/parsonsmatt/hspec-hedgehog/pull/2) @lehins - Documentation fix - [#3](https://github.com/parsonsmatt/hspec-hedgehog/pull/3) @parsonsmatt - Respect the `maxSuccess`, `maxDiscardRatio`, and `maxShrinks` properties of QuickCheck's `Args` type. - Reexport `modifyArgs`, `modifyMaxSuccess`, `modifyMaxDiscardRatio`, `modifyMaxSize`, `modifyMaxShrings` ## 0.0.1.0 - Initial Release