Extra expectations: shouldInclude & shouldIncludeAll

 * Add a new `shouldInclude` (hspec#38 / hspec#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 hspec#38

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

package.yaml

@@ -33,3 +33,4 @@ tests:
     dependencies:
       - nanospec
       - HUnit >= 1.5.0.0
+      - containers

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

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

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]