hspec-contrib-0.5.2/0000755000000000000000000000000007346545000012447 5ustar0000000000000000hspec-contrib-0.5.2/LICENSE0000644000000000000000000000217207346545000013456 0ustar0000000000000000Copyright (c) 2014-2023 Simon Hengel Copyright (c) 2014-2014 Junji Hashimoto 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: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 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. hspec-contrib-0.5.2/Setup.lhs0000644000000000000000000000011407346545000014253 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-contrib-0.5.2/hspec-contrib.cabal0000644000000000000000000000305707346545000016200 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: hspec-contrib version: 0.5.2 license: MIT license-file: LICENSE copyright: (c) 2011-2023 Simon Hengel, (c) 2014 Junji Hashimoto maintainer: Simon Hengel build-type: Simple category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: https://hspec.github.io/ synopsis: Contributed functionality for Hspec description: Contributed functionality for Hspec source-repository head type: git location: https://github.com/hspec/hspec subdir: hspec-contrib library ghc-options: -Wall hs-source-dirs: src build-depends: HUnit , base ==4.* , call-stack , hspec-core >=2.5.0 exposed-modules: Test.Hspec.Contrib.HUnit Test.Hspec.Contrib.Mocks.V1 Test.Hspec.Contrib.Retry other-modules: Paths_hspec_contrib default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: Helper Test.Hspec.Contrib.HUnitSpec Test.Hspec.Contrib.Mocks.V1Spec Test.Hspec.Contrib.RetrySpec Paths_hspec_contrib ghc-options: -Wall build-tool-depends: hspec-discover:hspec-discover build-depends: HUnit , QuickCheck , base ==4.* , call-stack , hspec , hspec-contrib , hspec-core >=2.6.0 default-language: Haskell2010 hspec-contrib-0.5.2/src/Test/Hspec/Contrib/0000755000000000000000000000000007346545000016617 5ustar0000000000000000hspec-contrib-0.5.2/src/Test/Hspec/Contrib/HUnit.hs0000644000000000000000000000174707346545000020213 0ustar0000000000000000-- | -- maintainer: Simon Hengel module Test.Hspec.Contrib.HUnit ( -- * Interoperability with HUnit fromHUnitTest , specListFromHUnitTest ) where import Test.Hspec.Core.Spec import Test.HUnit (Test (..)) -- | -- Convert a HUnit test suite to a spec. This can be used to run existing -- HUnit tests with Hspec. fromHUnitTest :: Test -> Spec fromHUnitTest = fromSpecList . specListFromHUnitTest -- | -- @specListFromHUnitTest@ is similar to `fromHUnitTest`, but it constructs a -- list of `SpecTree`s instead of a `Spec`. specListFromHUnitTest :: Test -> [SpecTree ()] specListFromHUnitTest t = case t of TestList xs -> map go xs x -> [go x] where go :: Test -> SpecTree () go t_ = case t_ of TestLabel s (TestCase e) -> specItem s e TestLabel s (TestList xs) -> specGroup s (map go xs) TestLabel s x -> specGroup s [go x] TestList xs -> specGroup "" (map go xs) TestCase e -> specItem "" e hspec-contrib-0.5.2/src/Test/Hspec/Contrib/Mocks/0000755000000000000000000000000007346545000017673 5ustar0000000000000000hspec-contrib-0.5.2/src/Test/Hspec/Contrib/Mocks/V1.hs0000644000000000000000000000272707346545000020525 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} module Test.Hspec.Contrib.Mocks.V1 ( stubAction , withSpy ) where import Test.HUnit import Data.CallStack (HasCallStack) import Data.IORef #if !MIN_VERSION_base(4,6,0) atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' = atomicModifyIORef #endif -- | Create a [test stub](https://en.wikipedia.org/wiki/Test_stub) action. -- -- >>> stub <- stubAction ["foo", "bar", "baz"] -- >>> stub -- "foo" -- >>> stub -- "bar" -- >>> stub -- "baz" -- >>> stub -- *** Exception: HUnitFailure ...stubAction: no values left... -- -- @since 0.5.2 stubAction :: HasCallStack => [a] -> IO (IO a) stubAction values = do ref <- newIORef values return $ do atomicModifyIORef ref takeValue >>= maybe noValuesLeft return where noValuesLeft :: IO a noValuesLeft = assertFailure "stubAction: no values left" takeValue :: [a] -> ([a], Maybe a) takeValue xs = case xs of [] -> ([], Nothing) a : as -> (as, Just a) -- | Create a [test spy](https://en.wikipedia.org/wiki/Test_double) action. -- -- Record any arguments that are passed to that action. -- -- >>> withSpy $ \ spy -> spy "foo" >> spy "bar" >> spy "baz" -- ["foo","bar","baz"] -- -- @since 0.5.2 withSpy :: ((a -> IO ()) -> IO ()) -> IO [a] withSpy action = do ref <- newIORef [] action (\ x -> atomicModifyIORef' ref $ \ xs -> (x : xs, ())) reverse `fmap` readIORef ref hspec-contrib-0.5.2/src/Test/Hspec/Contrib/Retry.hs0000644000000000000000000000171407346545000020263 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | -- maintainer: Junji Hashimoto module Test.Hspec.Contrib.Retry (retryWith) where import Test.Hspec.Core.Spec data Retry a = Retry Int a instance Example a => Example (Retry a) where type Arg (Retry a) = Arg a evaluateExample (Retry n example) a b c | n > 1 = do result <- safeEvaluateExample example a b c case result of Result _ Success{} -> return result Result _ Pending{} -> return result Result _ Failure{} -> retry | otherwise = evaluateExample example a b c where retry = evaluateExample (Retry (pred n) example) a b c -- | Retry evaluating example that may be failed until success. retryWith :: Int -- ^ number of retries, when this number is 1, just evaluate example and finish. -> a -- ^ retried example -> Retry a -- ^ Retry is instance of Example. retryWith = Retry hspec-contrib-0.5.2/test/0000755000000000000000000000000007346545000013426 5ustar0000000000000000hspec-contrib-0.5.2/test/Helper.hs0000644000000000000000000000036507346545000015205 0ustar0000000000000000module Helper ( module Test.Hspec , module Test.QuickCheck , module Control.Applicative , module Data.IORef ) where import Test.Hspec import Test.QuickCheck import Control.Applicative import Data.IORef hspec-contrib-0.5.2/test/Spec.hs0000644000000000000000000000005407346545000014653 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-contrib-0.5.2/test/Test/Hspec/Contrib/0000755000000000000000000000000007346545000017007 5ustar0000000000000000hspec-contrib-0.5.2/test/Test/Hspec/Contrib/HUnitSpec.hs0000644000000000000000000000225607346545000021212 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Contrib.HUnitSpec (spec) where import Helper import Test.Hspec.Core.Spec import Test.Hspec.Contrib.HUnit import Test.HUnit shouldYield :: Test -> [Tree () String] -> Expectation a `shouldYield` b = bimapForest (const ()) itemRequirement . snd <$> runSpecM (fromHUnitTest a) `shouldReturn` b spec :: Spec spec = do describe "fromHUnitTest" $ do let e = TestCase $ pure () it "works for a TestCase" $ do e `shouldYield` [Leaf ""] it "works for a labeled TestCase" $ do TestLabel "foo" e `shouldYield` [Leaf "foo"] it "works for a TestCase with nested labels" $ do (TestLabel "foo" . TestLabel "bar") e `shouldYield` [Node "foo" [Leaf "bar"]] it "works for a flat TestList" $ do TestList [e, e, e] `shouldYield` [Leaf "", Leaf "", Leaf ""] it "works for a nested TestList" $ do (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e] `shouldYield` [Node "foo" [Node "bar" [Leaf "one", Leaf "two", Leaf "three"]]] hspec-contrib-0.5.2/test/Test/Hspec/Contrib/Mocks/0000755000000000000000000000000007346545000020063 5ustar0000000000000000hspec-contrib-0.5.2/test/Test/Hspec/Contrib/Mocks/V1Spec.hs0000644000000000000000000000137307346545000021524 0ustar0000000000000000module Test.Hspec.Contrib.Mocks.V1Spec (spec) where import Test.Hspec import Test.HUnit.Lang import Test.Hspec.Contrib.Mocks.V1 hUnitFailure :: FailureReason -> HUnitFailure -> Bool hUnitFailure expected (HUnitFailure _ actual) = actual == expected spec :: Spec spec = do describe "stubAction" $ do it "creates a stub action" $ do stub <- stubAction [23, 42, 65 :: Int] stub `shouldReturn` 23 stub `shouldReturn` 42 stub `shouldReturn` 65 stub `shouldThrow` hUnitFailure (Reason "stubAction: no values left") describe "withSpy" $ do it "records arguments" $ do withSpy $ \ spy -> do spy "foo" spy "bar" spy "baz" `shouldReturn` ["foo", "bar", "baz"] hspec-contrib-0.5.2/test/Test/Hspec/Contrib/RetrySpec.hs0000644000000000000000000000070707346545000021267 0ustar0000000000000000module Test.Hspec.Contrib.RetrySpec (spec) where import Helper import Test.Hspec.Contrib.Retry spec :: Spec spec = do describe "retryWith" $ do ref <- runIO $ newIORef (0::Int) it "retry 11 times, then check the value" $ do let incr :: IO Int incr = do val <- readIORef ref writeIORef ref (val+1) return val retryWith 11 $ do incr `shouldReturn` (10::Int)