diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,5 @@ -# Revision history for hspec-hedgehog +# Changelog for hspec-hedgehog -## 0.1.0.0 -- YYYY-mm-dd +## 0.0.1.0 -* First version. Released on an unsuspecting world. +- Initial Release diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,19 +1,30 @@ -Copyright (c) 2017 Erik de Castro Lopo +Copyright Author name here (c) 2020 -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: +All rights reserved. -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. + * 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,51 @@ +# 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 +``` diff --git a/Test/Hspec/Hedgehog.hs b/Test/Hspec/Hedgehog.hs deleted file mode 100644 --- a/Test/Hspec/Hedgehog.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Test.Hspec.Hedgehog - ( prop - , evalHedgehogExample - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) - -import Data.Coerce (coerce) - -import Hedgehog (Property, Size (..), Test) -import qualified Hedgehog -import qualified Hedgehog.Internal.Property as HP -import qualified Hedgehog.Internal.Runner as HR -import qualified Hedgehog.Internal.Seed as HS -import Hedgehog.Internal.Report (Report (..), Status (..), TestCount (..)) - -import Test.Hspec.Core.Spec (Arg, Example (..), Spec) -import Test.Hspec.Core.Spec (ActionWith, Params, ProgressCallback, Result) -import qualified Test.Hspec.Core.Spec as Hspec - -prop :: String -> Test IO () -> Spec -prop str = Hspec.it str . Hedgehog.property - - -instance Example Property where - type Arg Property = () - evaluateExample = evalHedgehogExample - - -evalHedgehogExample :: MonadIO m - => Property -> Params -> (ActionWith (Arg Property) -> IO ()) -> ProgressCallback -> m Result -evalHedgehogExample p params _ reportProgress = do - seed <- HS.random - rep <- liftIO $ HR.checkReport HP.defaultConfig size seed (HP.propertyTest p) (reportProgress . reporter) - case reportStatus rep of - Waiting -> error "waiting" - Running -> error "running" - Shrinking _ -> error "shrinking" - Failed _ -> pure $ Hspec.Failure Nothing (Hspec.Reason "condition is false") - GaveUp -> error "running" - OK -> pure Hspec.Success - where - size = Size $ Hspec.paramsSmallCheckDepth params - - - reporter :: Report -> (Int, Int) - reporter r = - (coerce (reportTests r), Hspec.paramsSmallCheckDepth params) diff --git a/hspec-hedgehog.cabal b/hspec-hedgehog.cabal --- a/hspec-hedgehog.cabal +++ b/hspec-hedgehog.cabal @@ -1,44 +1,50 @@ --- Initial hspec-hedgehog.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ +cabal-version: 1.12 +name: hspec-hedgehog +version: 0.0.1.0 +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 -name: hspec-hedgehog -version: 0.0.0.1 -synopsis: Hedgehog support for the Hspec testing framework --- description: -homepage: https://github.com/erikd/hspec-hedgehog/ -license: MIT -license-file: LICENSE -author: Erik de Castro Lopo -maintainer: erikd@mega-nerd.com --- copyright: -category: Testing -build-type: Simple -extra-source-files: ChangeLog.md -cabal-version: >=1.10 +source-repository head + type: git + location: https://github.com/parsonsmatt/hspec-hedgehog library - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs - hs-source-dirs: . - - exposed-modules: Test.Hspec.Hedgehog - - build-depends: base >= 4.8 && < 5.0 - , hedgehog == 0.1.* - , hspec-core - -test-suite test - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs -threaded -O2 - type: exitcode-stdio-1.0 - - main-is: test.hs - hs-source-dirs: test - - other-modules: Test.Test.Hspec.Hedgehog + 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 + , HUnit >= 1.5 && < 2 + , QuickCheck >= 2.9.2 && < 3 + , splitmix >= 0.0.1 && < 1 + default-language: Haskell2010 - build-depends: base >= 4.8 && < 5.0 - , hedgehog - , hspec >= 2.3 && < 2.5 - , hspec-core - , hspec-hedgehog +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 + default-language: Haskell2010 diff --git a/src/Test/Hspec/Hedgehog.hs b/src/Test/Hspec/Hedgehog.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Hedgehog.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} + +-- | 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 + ( hedgehog + , 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 (UseColor, detectColor) +import Hedgehog.Internal.Property (TerminationCriteria (..), + TestCount (..), TestLimit (..), + propertyConfig, + propertyTerminationCriteria, + propertyTest) +import Hedgehog.Internal.Report as Hedge +import Hedgehog.Internal.Runner (checkReport) +import qualified Hedgehog.Internal.Seed as Seed +import Hedgehog.Internal.Source (HasCallStack) +import System.Random.SplitMix (unseedSMGen) +import Test.Hspec +import Test.Hspec.Core.Spec as Hspec +import Test.HUnit.Base (assertFailure) +import Test.QuickCheck.Random (QCGen (..)) +import Test.QuickCheck.Test (replay) + +-- | 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 = propertyConfig prop + maxTests = case propertyTerminationCriteria propConfig of + EarlyTermination _ (TestLimit n) -> n + NoEarlyTermination _ (TestLimit n) -> n + NoConfidenceTermination (TestLimit n) -> n + testCount report = case reportTests report of + TestCount n -> n + cb progress = do + ppprogress <- renderProgress color Nothing progress + 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 =<< case reportStatus hedgeResult of + Failed FailureReport{..} -> do + -- let fromSpan Span{..} = + -- Location + -- { locationFile = spanFile + -- , locationLine = coerce spanStartLine + -- , locationColumn = coerce spanStartColumn + -- } + -- pure + -- $ Result "" + -- $ Hspec.Failure (fromSpan <$> failureLocation) _h -- ppresult + assertFailure ppresult + GaveUp -> + assertFailure ppresult + OK -> + pure $ Result "" Success + readIORef ref + where + mkFail = Result diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,41 @@ +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 diff --git a/test/Test/Test/Hspec/Hedgehog.hs b/test/Test/Test/Hspec/Hedgehog.hs deleted file mode 100644 --- a/test/Test/Test/Hspec/Hedgehog.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Test.Test.Hspec.Hedgehog - ( hedgehogSpec - ) where - -import Hedgehog (Property) -import qualified Hedgehog -import qualified Hedgehog.Gen as HG -import qualified Hedgehog.Range as HR - -import Test.Hspec.Hedgehog - -import Test.Hspec (Spec, errorCall, shouldReturn, shouldThrow) -import qualified Test.Hspec.Core.Spec as Hspec - - -hedgehogSpec :: Spec -hedgehogSpec = do - Hspec.describe "evaluateExample" $ do - Hspec.context "Property" $ do - Hspec.it "returns Success if property holds" $ do - evaluateExample (Hedgehog.property $ Hedgehog.assert True) `shouldReturn` Hspec.Success - - Hspec.it "returns Fail if property does not hold" $ do - evaluateExample (Hedgehog.property $ Hedgehog.assert False) `shouldReturn` Hspec.Failure Nothing (Hspec.Reason "condition is false") - - Hspec.it "shows what falsified it" $ do - evaluateExample notTwo `shouldReturn` Hspec.Failure Nothing (Hspec.Reason "condition is false") - - Hspec.it "propagates exceptions" $ do - evaluateExample (error "foobar") `shouldThrow` errorCall "foobar" - where - evaluateExample :: Property -> IO Hspec.Result - evaluateExample e = evalHedgehogExample e Hspec.defaultParams (const $ pure ()) (const $ pure ()) - - notTwo :: Property - notTwo = Hedgehog.property $ do - x <- Hedgehog.forAll $ HG.integral (HR.linear 0 10) - Hedgehog.assert $ x /= (2 :: Int) diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,6 +0,0 @@ - -import qualified Test.Hspec as Hspec -import Test.Test.Hspec.Hedgehog - -main :: IO () -main = Hspec.hspec hedgehogSpec