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