hspec-expectations-0.8.2/0000755000000000000000000000000013000602706013507 5ustar0000000000000000hspec-expectations-0.8.2/LICENSE0000644000000000000000000000206713000602706014521 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.8.2/Setup.lhs0000644000000000000000000000011413000602706015313 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-expectations-0.8.2/hspec-expectations.cabal0000644000000000000000000000307213000602706020303 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack name: hspec-expectations version: 0.8.2 synopsis: Catchy combinators for HUnit description: Catchy combinators for HUnit: bug-reports: https://github.com/hspec/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/hspec/hspec-expectations#readme source-repository head type: git location: https://github.com/hspec/hspec-expectations library hs-source-dirs: src ghc-options: -Wall build-depends: base == 4.* , call-stack , HUnit exposed-modules: Test.Hspec.Expectations Test.Hspec.Expectations.Contrib other-modules: Test.Hspec.Expectations.Matcher Paths_hspec_expectations default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test src ghc-options: -Wall build-depends: base == 4.* , call-stack , nanospec , HUnit >= 1.5.0.0 other-modules: Test.Hspec.Expectations.MatcherSpec Test.Hspec.ExpectationsSpec Test.Hspec.Expectations Test.Hspec.Expectations.Contrib Test.Hspec.Expectations.Matcher default-language: Haskell2010 hspec-expectations-0.8.2/test/0000755000000000000000000000000013000602706014466 5ustar0000000000000000hspec-expectations-0.8.2/test/Spec.hs0000644000000000000000000000054513000602706015720 0ustar0000000000000000module Main where import Test.Hspec import qualified Test.Hspec.ExpectationsSpec import qualified Test.Hspec.Expectations.MatcherSpec spec :: Spec spec = do describe "Test.Hspec.ExpectationsSpec" Test.Hspec.ExpectationsSpec.spec describe "Test.Hspec.Expectations.MatcherSpec" Test.Hspec.Expectations.MatcherSpec.spec main :: IO () main = hspec spec hspec-expectations-0.8.2/test/Test/0000755000000000000000000000000013000602706015405 5ustar0000000000000000hspec-expectations-0.8.2/test/Test/Hspec/0000755000000000000000000000000013000602706016447 5ustar0000000000000000hspec-expectations-0.8.2/test/Test/Hspec/ExpectationsSpec.hs0000644000000000000000000001152613000602706022271 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} module Test.Hspec.ExpectationsSpec (spec) where import Control.Exception import Test.HUnit.Lang import Test.Hspec (Spec, describe, it) import Test.Hspec.Expectations hiding (HasCallStack) import Data.CallStack 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} spec :: Spec spec = do describe "shouldBe" $ do it "succeeds if arguments are equal" $ do "foo" `shouldBe` "foo" it "fails if arguments are not equal" $ do ("foo" `shouldBe` "bar") `shouldThrow` expectationFailed (ExpectedButGot Nothing "\"bar\"" "\"foo\"") describe "shouldSatisfy" $ do it "succeeds if value satisfies predicate" $ do "" `shouldSatisfy` null it "fails if value does not satisfy predicate" $ do ("foo" `shouldSatisfy` null) `shouldThrow` expectationFailed (Reason "predicate failed on: \"foo\"") describe "shouldReturn" $ do it "succeeds if arguments represent equal values" $ do return "foo" `shouldReturn` "foo" it "fails if arguments do not represent equal values" $ do (return "foo" `shouldReturn` "bar") `shouldThrow` expectationFailed (ExpectedButGot Nothing "\"bar\"" "\"foo\"") describe "shouldStartWith" $ do it "succeeds if second is prefix of first" $ do "hello world" `shouldStartWith` "hello" it "fails if second is not prefix of first" $ do ("hello world" `shouldStartWith` "world") `shouldThrow` expectationFailed (Reason "\"hello world\" does not start with \"world\"") describe "shouldEndWith" $ do it "succeeds if second is suffix of first" $ do "hello world" `shouldEndWith` "world" it "fails if second is not suffix of first" $ do ("hello world" `shouldEndWith` "hello") `shouldThrow` expectationFailed (Reason "\"hello world\" does not end with \"hello\"") describe "shouldContain" $ do it "succeeds if second argument is contained in the first" $ do "I'm an hello world message" `shouldContain` "an hello" it "fails if first argument does not contain the second" $ do ("foo" `shouldContain` "bar") `shouldThrow` expectationFailed (Reason "\"foo\" does not contain \"bar\"") describe "shouldNotBe" $ do it "succeeds if arguments are not equal" $ do "foo" `shouldNotBe` "bar" it "fails if arguments are equal" $ do ("foo" `shouldNotBe` "foo") `shouldThrow` expectationFailed (Reason "not expected: \"foo\"") describe "shouldNotSatisfy" $ do it "succeeds if value does not satisfy predicate" $ do "bar" `shouldNotSatisfy` null it "fails if the value does satisfy predicate" $ do ("" `shouldNotSatisfy` null) `shouldThrow` expectationFailed (Reason "predicate succeeded on: \"\"") describe "shouldNotReturn" $ do it "succeeds if arguments does not represent equal values" $ do return "foo" `shouldNotReturn` "bar" it "fails if arguments do represent equal values" $ do (return "foo" `shouldNotReturn` "foo") `shouldThrow` expectationFailed (Reason "not expected: \"foo\"") describe "shouldNotContain" $ do it "succeeds if second argument is not contained in the first" $ do "I'm an hello world message" `shouldNotContain` "test" it "fails if first argument does contain the second" $ do ("foo abc def" `shouldNotContain` "def") `shouldThrow` expectationFailed (Reason "\"foo abc def\" does contain \"def\"") describe "shouldThrow" $ do it "can be used to require a specific exception" $ do throwIO DivideByZero `shouldThrow` (== DivideByZero) it "can be used to require any exception" $ do error "foobar" `shouldThrow` anyException it "can be used to require an exception of a specific type" $ do error "foobar" `shouldThrow` anyErrorCall it "can be used to require a specific exception" $ do error "foobar" `shouldThrow` errorCall "foobar" it "fails, if a required specific exception is not thrown" $ do (throwIO Overflow `shouldThrow` (== DivideByZero)) `shouldThrow` expectationFailed (Reason "predicate failed on expected exception: ArithException (arithmetic overflow)") it "fails, if any exception is required, but no exception is thrown" $ do (return () `shouldThrow` anyException) `shouldThrow` expectationFailed (Reason "did not get expected exception: SomeException") it "fails, if an exception of a specific type is required, but no exception is thrown" $ do (return () `shouldThrow` anyErrorCall) `shouldThrow` expectationFailed (Reason "did not get expected exception: ErrorCall") hspec-expectations-0.8.2/test/Test/Hspec/Expectations/0000755000000000000000000000000013000602706021115 5ustar0000000000000000hspec-expectations-0.8.2/test/Test/Hspec/Expectations/MatcherSpec.hs0000644000000000000000000000231313000602706023646 0ustar0000000000000000module Test.Hspec.Expectations.MatcherSpec (main, spec) where import Test.Hspec import Test.Hspec.Expectations.Matcher main :: IO () main = hspec spec spec :: Spec spec = do describe "matchList" $ do it "succeeds if arguments are empty lists" $ do matchList [] ([] :: [Int]) `shouldBe` Nothing it "succeeds if arguments are equal up to permutation" $ do matchList [1, 2, 2, 3] [3, 2, 1, 2 :: Int] `shouldBe` Nothing context "when arguments are not equal up to permutation" $ do it "shows extra elements" $ do [1, 2, 2, 3] `matchList` [1, 2, 3 :: Int] `shouldBe` (Just . unlines) [ "Actual list is not a permutation of expected list!" , " expected list contains: [1, 2, 3]" , " actual list contains: [1, 2, 2, 3]" , " the extra elements are: [2]" ] it "shows missing elements" $ do [1, 2, 3] `matchList` [1, 2, 2, 3 :: Int] `shouldBe` (Just . unlines) [ "Actual list is not a permutation of expected list!" , " expected list contains: [1, 2, 2, 3]" , " actual list contains: [1, 2, 3]" , " the missing elements are: [2]" ] hspec-expectations-0.8.2/src/0000755000000000000000000000000013000602706014276 5ustar0000000000000000hspec-expectations-0.8.2/src/Test/0000755000000000000000000000000013000602706015215 5ustar0000000000000000hspec-expectations-0.8.2/src/Test/Hspec/0000755000000000000000000000000013000602706016257 5ustar0000000000000000hspec-expectations-0.8.2/src/Test/Hspec/Expectations.hs0000644000000000000000000001525613000602706021272 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ImplicitParams #-} -- | -- 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 -- * Re-exports , HasCallStack ) where import qualified Test.HUnit import Test.HUnit ((@?=)) import Control.Exception import Data.Typeable import Data.List import Control.Monad (unless) import Test.Hspec.Expectations.Matcher #if MIN_VERSION_HUnit(1,4,0) import Data.CallStack (HasCallStack) #else #if MIN_VERSION_base(4,8,1) import qualified GHC.Stack as GHC type HasCallStack = (?loc :: GHC.CallStack) #else import GHC.Exts (Constraint) type HasCallStack = (() :: Constraint) #endif #endif type Expectation = Test.HUnit.Assertion expectationFailure :: HasCallStack => String -> Expectation expectationFailure = Test.HUnit.assertFailure expectTrue :: HasCallStack => 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@. shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation actual `shouldBe` expected = actual @?= expected -- | -- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@. shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v) compareWith :: (HasCallStack, Show 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@, shouldStartWith :: (HasCallStack, 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@, shouldEndWith :: (HasCallStack, 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@. shouldContain :: (HasCallStack, 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 shouldMatchList :: (HasCallStack, 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@. shouldReturn :: (HasCallStack, 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@ shouldNotBe :: (HasCallStack, 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@. shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation v `shouldNotSatisfy` p = expectTrue ("predicate succeeded on: " ++ show v) ((not . p) v) -- | -- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not -- contained anywhere in @list@. shouldNotContain :: (HasCallStack, 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@. shouldNotReturn :: (HasCallStack, 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'. shouldThrow :: (HasCallStack, 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 #if MIN_VERSION_base(4,9,0) errorCall s (ErrorCallWithLocation msg _) = s == msg #else errorCall s (ErrorCall msg) = s == msg #endif anyIOException :: Selector IOException anyIOException = const True anyArithException :: Selector ArithException anyArithException = const True hspec-expectations-0.8.2/src/Test/Hspec/Expectations/0000755000000000000000000000000013000602706020725 5ustar0000000000000000hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Matcher.hs0000644000000000000000000000163713000602706022653 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) hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Contrib.hs0000644000000000000000000000127213000602706022663 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