From 5d3243df0ae9eb5124a2523a4038914ad1c6e7f2 Mon Sep 17 00:00:00 2001 From: Nick B Date: Wed, 28 Apr 2021 22:13:02 +0100 Subject: [PATCH 1/2] Extra expectations: shouldInclude & shouldIncludeAll * Add a new `shouldInclude` (#38 / #35) * Also, a more general `shouldIncludeAll` which tests provides subset-like expectations (generalised to any `Foldable`s), with helpful (hopefully) messaging about missing elements * Replicate a few unexported helper functions, rather than mess with the overall structure * Add some tests around these * Update Hpack / Cabal Closes #38 --- hspec-expectations.cabal | 2 + package.yaml | 1 + src/Test/Hspec/Expectations/Contrib.hs | 51 ++++++++++++++++++++++++++ test/Spec.hs | 2 + 4 files changed, 56 insertions(+) diff --git a/hspec-expectations.cabal b/hspec-expectations.cabal index 7f1f378..c2c9ebe 100644 --- a/hspec-expectations.cabal +++ b/hspec-expectations.cabal @@ -47,9 +47,11 @@ test-suite spec build-depends: base == 4.* , call-stack + , containers , nanospec , HUnit >= 1.5.0.0 other-modules: + Test.Hspec.Expectations.ContribSpec Test.Hspec.Expectations.MatcherSpec Test.Hspec.ExpectationsSpec Test.Hspec.Expectations diff --git a/package.yaml b/package.yaml index a065a75..1a35b02 100644 --- a/package.yaml +++ b/package.yaml @@ -33,3 +33,4 @@ tests: dependencies: - nanospec - HUnit >= 1.5.0.0 + - containers diff --git a/src/Test/Hspec/Expectations/Contrib.hs b/src/Test/Hspec/Expectations/Contrib.hs index 80ffef5..49abdb8 100644 --- a/src/Test/Hspec/Expectations/Contrib.hs +++ b/src/Test/Hspec/Expectations/Contrib.hs @@ -7,8 +7,14 @@ module Test.Hspec.Expectations.Contrib ( -- | (useful in combination with `shouldSatisfy`) isLeft , isRight +, shouldInclude +, shouldIncludeAll ) where +import Control.Monad (unless) +import Test.Hspec.Expectations (HasCallStack, Expectation, expectationFailure) +import Data.Foldable (foldl') +import Data.List (intercalate) #if MIN_VERSION_base(4,7,0) import Data.Either @@ -24,3 +30,48 @@ isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True #endif + + +-- | +-- @container \`shouldInclude\` item@ sets the expectation that @item@ appears at least once +-- in @container@. +shouldInclude :: (HasCallStack, Show a, Show (t a), Eq a, Foldable t) + => t a + -> a + -> Expectation +shouldInclude = compareWithAny elem "does not include" + + +-- | +-- @container \`shouldIncludeAll\` subContainer@ sets the expectation +-- that all items in @subContainer@ appear at least once in @container@. +shouldIncludeAll :: (HasCallStack, Foldable t1, Foldable t2, Show a, Show (t1 a), Show (t2 a), Eq a) + => t1 a + -> t2 a + -> Expectation +actual `shouldIncludeAll` subset = expectTrue message (all isIncluded subset) + where + isIncluded = (`elem` actual) + message = show actual <> " did not include all of " <> show subset <> " - missing: " <> missing + missing = intercalate ", " (fmap show missingItems) + missingItems = foldl' accumulateIfIncluded [] subset + accumulateIfIncluded acc val = if isIncluded val then acc else (val : acc) + + +-- Cloned from 'Test.Hspec.Expectations' +expectTrue :: HasCallStack + => String + -> Bool + -> Expectation +expectTrue msg b = unless b (expectationFailure msg) + + +compareWithAny :: (HasCallStack, Show a, Show b) + => (a -> b -> Bool) + -> String + -> b + -> a + -> Expectation +compareWithAny comparator errorDesc result expected = expectTrue errorMsg (comparator expected result) + where + errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected diff --git a/test/Spec.hs b/test/Spec.hs index b243222..7b4c65b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,11 +4,13 @@ import Test.Hspec import qualified Test.Hspec.ExpectationsSpec import qualified Test.Hspec.Expectations.MatcherSpec +import qualified Test.Hspec.Expectations.ContribSpec spec :: Spec spec = do describe "Test.Hspec.ExpectationsSpec" Test.Hspec.ExpectationsSpec.spec describe "Test.Hspec.Expectations.MatcherSpec" Test.Hspec.Expectations.MatcherSpec.spec + describe "Test.Hspec.Expectations.ContribSpec" Test.Hspec.Expectations.ContribSpec.spec main :: IO () main = hspec spec From c2f0a07a6e7d3b8886a00783178c4c5488580b35 Mon Sep 17 00:00:00 2001 From: Nick B Date: Wed, 28 Apr 2021 22:13:02 +0100 Subject: [PATCH 2/2] Extra expectations: shouldInclude & shouldIncludeAll * Add a new `shouldInclude` (#38 / #35) * Also, a more general `shouldIncludeAll` which provides subset-like expectations (generalised to any `Foldable`s), with helpful (hopefully) messaging about missing elements * Add some tests around these * Replicate a few unexported helper functions, rather than mess with the overall structure * Update Hpack / Cabal Closes #38 --- test/Test/Hspec/Expectations/ContribSpec.hs | 52 +++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 test/Test/Hspec/Expectations/ContribSpec.hs diff --git a/test/Test/Hspec/Expectations/ContribSpec.hs b/test/Test/Hspec/Expectations/ContribSpec.hs new file mode 100644 index 0000000..fb7db22 --- /dev/null +++ b/test/Test/Hspec/Expectations/ContribSpec.hs @@ -0,0 +1,52 @@ +module Test.Hspec.Expectations.ContribSpec (spec) where + +import Test.Hspec (Spec, describe, it) + +import Test.Hspec.Expectations hiding (HasCallStack) +import Test.Hspec.Expectations.Contrib +import Test.HUnit.Lang +import Data.CallStack +import qualified Data.Set as S + + +expectationFailed :: HasCallStack => FailureReason -> HUnitFailure -> Bool +expectationFailed msg (HUnitFailure l m) = m == msg && (fmap setColumn l) == (fmap setColumn location) + where + location = case reverse callStack of + [] -> Nothing + (_, loc) : _ -> Just loc + location :: Maybe SrcLoc + + setColumn loc_ = loc_{srcLocStartCol = 0, srcLocEndCol = 0} + + +one :: Int +one = 1 + +spec :: Spec +spec = do + describe "shouldInclude" $ do + it "fails for an empty list" $ do + ([] `shouldInclude` one) `shouldThrow` expectationFailed (Reason "[] does not include 1") + + it "succeeds for a single item list" $ do + [one] `shouldInclude` one + + it "succeeds for a longer list" $ do + [1, 2, 2, 3] `shouldInclude` one + + it "succeeds with repeated inclusion" $ do + [1, 2, 1] `shouldInclude` one + + describe "shouldIncludeAll" $ do + it "should pass for lists in order" $ + [1 :: Int, 2, 3] `shouldIncludeAll` [1, 3] + + it "should fail with a nice message for lists with extra item" $ + ([one, 3] `shouldIncludeAll` [1, 2, 3]) `shouldThrow` expectationFailed (Reason "[1,3] did not include all of [1,2,3] - missing: 2") + + it "should pass for lists out of order" $ + [0, one, 2, 3] `shouldIncludeAll` [3, 2, 0, 1] + + it "should pass for sets out of order" $ + S.fromList [0 :: Int, 1, 2] `shouldIncludeAll` [2, 1]