hspec-expectations-0.7.2/0000755000000000000000000000000012565570164013527 5ustar0000000000000000hspec-expectations-0.7.2/hspec-expectations.cabal0000644000000000000000000000210512565570164020317 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.5.4. -- -- see: https://github.com/sol/hpack name: hspec-expectations version: 0.7.2 synopsis: Catchy combinators for HUnit description: Catchy combinators for HUnit: bug-reports: https://github.com/sol/hspec-expectations/issues license: MIT license-file: LICENSE copyright: (c) 2011-2015 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple category: Testing cabal-version: >= 1.10 homepage: https://github.com/sol/hspec-expectations#readme source-repository head type: git location: https://github.com/sol/hspec-expectations library hs-source-dirs: src ghc-options: -Wall build-depends: base == 4.* , HUnit exposed-modules: Test.Hspec.Expectations Test.Hspec.Expectations.Contrib other-modules: Test.Hspec.Expectations.Matcher default-language: Haskell2010 hspec-expectations-0.7.2/LICENSE0000644000000000000000000000206712565570164014541 0ustar0000000000000000Copyright (c) 2011-2015 Simon Hengel 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-expectations-0.7.2/Setup.lhs0000644000000000000000000000011412565570164015333 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-expectations-0.7.2/src/0000755000000000000000000000000012565570164014316 5ustar0000000000000000hspec-expectations-0.7.2/src/Test/0000755000000000000000000000000012565570164015235 5ustar0000000000000000hspec-expectations-0.7.2/src/Test/Hspec/0000755000000000000000000000000012565570164016277 5ustar0000000000000000hspec-expectations-0.7.2/src/Test/Hspec/Expectations.hs0000644000000000000000000001463512565570164021312 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) #define HAS_SOURCE_LOCATIONS {-# LANGUAGE ImplicitParams #-} #endif -- | -- Introductory documentation: module Test.Hspec.Expectations ( -- * Setting expectations Expectation , expectationFailure , shouldBe , shouldSatisfy , shouldStartWith , shouldEndWith , shouldContain , shouldMatchList , shouldReturn , shouldNotBe , shouldNotSatisfy , shouldNotContain , shouldNotReturn -- * Expecting exceptions , shouldThrow -- ** Selecting exceptions , Selector -- ** Predefined type-based selectors -- | -- There are predefined selectors for some standard exceptions. Each selector -- is just @const True@ with an appropriate type. , anyException , anyErrorCall , anyIOException , anyArithException -- ** Combinators for defining value-based selectors -- | -- Some exceptions (most prominently `ErrorCall`) have no `Eq` instance. -- Selecting a specific value would require pattern matching. -- -- For such exceptions, combinators that construct selectors are provided. -- Each combinator corresponds to a constructor; it takes the same arguments, -- and has the same name (but starting with a lower-case letter). , errorCall ) where import qualified Test.HUnit import Control.Exception import Data.Typeable import Data.List import Control.Monad (unless) import Test.Hspec.Expectations.Matcher #ifdef HAS_SOURCE_LOCATIONS import GHC.Stack #define with_loc(NAME, TYPE) NAME :: (?loc :: CallStack) => TYPE #else #define with_loc(NAME, TYPE) NAME :: TYPE #endif type Expectation = Test.HUnit.Assertion with_loc(expectationFailure, String -> Expectation) expectationFailure = Test.HUnit.assertFailure with_loc(expectTrue, String -> Bool -> Expectation) expectTrue msg b = unless b (expectationFailure msg) infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow` infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn` -- | -- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal -- to @expected@. with_loc(shouldBe, (Show a, Eq a) => a -> a -> Expectation) actual `shouldBe` expected = expectTrue ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected) -- | -- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@. with_loc(shouldSatisfy, (Show a) => a -> (a -> Bool) -> Expectation) v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v) with_loc(compareWith, (Show a, Eq a) => (a -> a -> Bool) -> String -> a -> a -> Expectation) compareWith comparator errorDesc result expected = expectTrue errorMsg (comparator expected result) where errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected -- | -- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@, with_loc(shouldStartWith, (Show a, Eq a) => [a] -> [a] -> Expectation) shouldStartWith = compareWith isPrefixOf "does not start with" -- | -- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@, with_loc(shouldEndWith, (Show a, Eq a) => [a] -> [a] -> Expectation) shouldEndWith = compareWith isSuffixOf "does not end with" -- | -- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained, -- wholly and intact, anywhere in @list@. with_loc(shouldContain, (Show a, Eq a) => [a] -> [a] -> Expectation) shouldContain = compareWith isInfixOf "does not contain" -- | -- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same -- elements that @ys@ has, possibly in another order with_loc(shouldMatchList, (Show a, Eq a) => [a] -> [a] -> Expectation) xs `shouldMatchList` ys = maybe (return ()) expectationFailure (matchList xs ys) -- | -- @action \`shouldReturn\` expected@ sets the expectation that @action@ -- returns @expected@. with_loc(shouldReturn, (Show a, Eq a) => IO a -> a -> Expectation) action `shouldReturn` expected = action >>= (`shouldBe` expected) -- | -- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not -- equal to @notExpected@ with_loc(shouldNotBe, (Show a, Eq a) => a -> a -> Expectation) actual `shouldNotBe` notExpected = expectTrue ("not expected: " ++ show actual) (actual /= notExpected) -- | -- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@. with_loc(shouldNotSatisfy, (Show a) => a -> (a -> Bool) -> Expectation) v `shouldNotSatisfy` p = expectTrue ("predicate succeded on: " ++ show v) ((not . p) v) -- | -- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not -- contained anywhere in @list@. with_loc(shouldNotContain, (Show a, Eq a) => [a] -> [a] -> Expectation) list `shouldNotContain` sublist = expectTrue errorMsg ((not . isInfixOf sublist) list) where errorMsg = show list ++ " does contain " ++ show sublist -- | -- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@ -- does not return @notExpected@. with_loc(shouldNotReturn, (Show a, Eq a) => IO a -> a -> Expectation) action `shouldNotReturn` notExpected = action >>= (`shouldNotBe` notExpected) -- | -- A @Selector@ is a predicate; it can simultaneously constrain the type and -- value of an exception. type Selector a = (a -> Bool) -- | -- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws -- an exception. The precise nature of the expected exception is described -- with a 'Selector'. with_loc(shouldThrow, Exception e => IO a -> Selector e -> Expectation) action `shouldThrow` p = do r <- try action case r of Right _ -> expectationFailure $ "did not get expected exception: " ++ exceptionType Left e -> (`expectTrue` p e) $ "predicate failed on expected exception: " ++ exceptionType ++ " (" ++ show e ++ ")" where -- a string repsentation of the expected exception's type exceptionType = (show . typeOf . instanceOf) p where instanceOf :: Selector a -> a instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance" anyException :: Selector SomeException anyException = const True anyErrorCall :: Selector ErrorCall anyErrorCall = const True errorCall :: String -> Selector ErrorCall errorCall s (ErrorCall msg) = s == msg anyIOException :: Selector IOException anyIOException = const True anyArithException :: Selector ArithException anyArithException = const True hspec-expectations-0.7.2/src/Test/Hspec/Expectations/0000755000000000000000000000000012565570164020745 5ustar0000000000000000hspec-expectations-0.7.2/src/Test/Hspec/Expectations/Contrib.hs0000644000000000000000000000127212565570164022703 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Experimental combinators, that may become part of the main distribution, if -- they turn out to be useful for a wider audience. module Test.Hspec.Expectations.Contrib ( -- * Predicates -- | (useful in combination with `shouldSatisfy`) isLeft , isRight ) where #if MIN_VERSION_base(4,7,0) import Data.Either #else isLeft :: Either a b -> Bool {-# DEPRECATED isLeft "use Data.Either.Compat.isLeft from package base-compat instead" #-} isLeft (Left _) = True isLeft (Right _) = False isRight :: Either a b -> Bool {-# DEPRECATED isRight "use Data.Either.Compat.isRight from package base-compat instead" #-} isRight (Left _) = False isRight (Right _) = True #endif hspec-expectations-0.7.2/src/Test/Hspec/Expectations/Matcher.hs0000644000000000000000000000163712565570164022673 0ustar0000000000000000module Test.Hspec.Expectations.Matcher (matchList) where import Prelude hiding (showList) import Data.List matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String xs `matchList` ys | null extra && null missing = Nothing | otherwise = Just (err "") where extra = xs \\ ys missing = ys \\ xs msgAndList msg zs = showString msg . showList zs . showString "\n" optMsgList msg zs = if null zs then id else msgAndList msg zs err :: ShowS err = showString "Actual list is not a permutation of expected list!\n" . msgAndList " expected list contains: " ys . msgAndList " actual list contains: " xs . optMsgList " the missing elements are: " missing . optMsgList " the extra elements are: " extra showList :: Show a => [a] -> ShowS showList xs = showChar '[' . foldr (.) (showChar ']') (intersperse (showString ", ") $ map shows xs)