hspec-expectations-0.5.0.1/0000755000000000000000000000000012251063346013651 5ustar0000000000000000hspec-expectations-0.5.0.1/LICENSE0000644000000000000000000000206712251063346014663 0ustar0000000000000000Copyright (c) 2011-2013 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.5.0.1/README.lhs0000644000000000000000000000521412251063346015320 0ustar0000000000000000# Catchy combinators for HUnit (inspired by [ScalaTest's ShouldMatchers](http://www.scalatest.org/)) The three main primitives are `shouldBe`, `shouldSatisfy` and `shouldThrow`. They can be used with [HUnit](http://hackage.haskell.org/package/HUnit), or any framework that integrates with HUnit, like [test-framework](http://hackage.haskell.org/package/test-framework) or [Hspec](http://hackage.haskell.org/package/hspec). ## An introductory example Here is an example that uses Hspec. It's a partial specification of itself. ~~~ {.haskell .literate} import Test.Hspec import Control.Exception main :: IO () main = hspec $ do describe "shouldBe" $ do it "asserts equality" $ do "foo" `shouldBe` "foo" describe "shouldSatisfy" $ do it "asserts that a predicate holds" $ do "bar" `shouldSatisfy` (not . null) describe "shouldThrow" $ do it "asserts that an exception is thrown" $ do evaluate (1 `div` 0 :: Int) `shouldThrow` (== DivideByZero) ~~~ ## shouldBe `shouldBe` is just an alias for HUnit's `@?=`. ## shouldSatisfy `shouldSatisfy` asserts that some predicate holds for a given value. ~~~ {.haskell} "bar" `shouldSatisfy` (not . null) ~~~ It is similar to HUnit's `assertBool`, but gives a useful error message. >>> 23 `shouldSatisfy` (> 42) *** Exception: HUnitFailure "23 did not satisfy predicate!" ## shouldReturn `shouldReturn` asserts that an action returns a given value. ~~~ {.haskell} launchMissiles `shouldReturn` Left "permission error" ~~~ ## shouldThrow `shouldThrow` asserts that an exception is thrown. The precise nature of that exception is described with a `Selector`. ~~~ {.haskell} error "foobar" `shouldThrow` anyException ~~~ A `Selector` is a predicate, it can simultaneously constrain the type and value of an exception. ~~~ {.haskell} throw DivideByZero `shouldThrow` (== DivideByZero) ~~~ To select all exceptions of a given type, `const True` can be used. ~~~ {.haskell} error "foobar" `shouldThrow` (const True :: Selector ErrorCall) ~~~ For convenience, predefined selectors for some standard exceptions are provided. ~~~ {.haskell} error "foobar" `shouldThrow` anyErrorCall ~~~ Some exceptions (like `ErrorCall`) have no `Eq` instance, so checking for a specific value requires pattern matching. ~~~ {.haskell} error "foobar" `shouldThrow` (\e -> case e of ErrorCall "foobar" -> True _ -> False ) ~~~ 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). ~~~ {.haskell} error "foobar" `shouldThrow` errorCall "foobar" ~~~ hspec-expectations-0.5.0.1/Setup.lhs0000644000000000000000000000011412251063346015455 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-expectations-0.5.0.1/hspec-expectations.cabal0000644000000000000000000000241412251063346020444 0ustar0000000000000000name: hspec-expectations version: 0.5.0.1 synopsis: Catchy combinators for HUnit description: Catchy combinators for HUnit: license: MIT license-file: LICENSE copyright: (c) 2011-2013 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple category: Testing cabal-version: >= 1.8 homepage: https://github.com/sol/hspec-expectations#readme source-repository head type: git location: https://github.com/sol/hspec-expectations library ghc-options: -Wall build-depends: base < 4.8 , HUnit hs-source-dirs: src exposed-modules: Test.Hspec.Expectations , Test.Hspec.Expectations.Contrib test-suite spec main-is: Spec.hs type: exitcode-stdio-1.0 ghc-options: -Wall -Werror hs-source-dirs: src , test build-depends: base , HUnit , silently , hspec >= 1.3 test-suite readme type: exitcode-stdio-1.0 ghc-options: -Wall -Werror -pgmL markdown-unlit -optL haskell+literate main-is: README.lhs build-depends: base , hspec >= 1.3 , markdown-unlit hspec-expectations-0.5.0.1/test/0000755000000000000000000000000012251063346014630 5ustar0000000000000000hspec-expectations-0.5.0.1/test/Spec.hs0000644000000000000000000000005412251063346016055 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-expectations-0.5.0.1/src/0000755000000000000000000000000012251063346014440 5ustar0000000000000000hspec-expectations-0.5.0.1/src/Test/0000755000000000000000000000000012251063346015357 5ustar0000000000000000hspec-expectations-0.5.0.1/src/Test/Hspec/0000755000000000000000000000000012251063346016421 5ustar0000000000000000hspec-expectations-0.5.0.1/src/Test/Hspec/Expectations.hs0000644000000000000000000001005612251063346021425 0ustar0000000000000000-- | -- Introductory documentation: module Test.Hspec.Expectations ( -- * Setting expectations Expectation , expectationFailure , shouldBe , shouldSatisfy , shouldContain , shouldMatchList , shouldReturn -- * 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 Test.HUnit (Assertion, (@?=), assertBool, assertFailure) import Control.Exception import Data.Typeable import Data.List ((\\), isInfixOf) type Expectation = Assertion -- | This is just an alias for HUnit's `assertFailure`. expectationFailure :: String -> Expectation expectationFailure = assertFailure infix 1 `shouldBe`, `shouldSatisfy`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow` -- | -- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal -- to @expected@ (this is just an alias for `@?=`). shouldBe :: (Show a, Eq a) => a -> a -> Expectation actual `shouldBe` expected = actual @?= expected -- | -- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@. shouldSatisfy :: (Show a) => a -> (a -> Bool) -> Expectation v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) -- | -- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained, -- wholly and intact, anywhere in the second. shouldContain :: (Show a, Eq a) => [a] -> [a] -> Expectation list `shouldContain` sublist = assertBool errorMsg (sublist `isInfixOf` list) where errorMsg = show list ++ " doesn't contain " ++ show sublist -- | -- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same -- elements that @ys@ has, possibly in another order shouldMatchList :: (Show a, Eq a) => [a] -> [a] -> Expectation xs `shouldMatchList` ys = assertBool errorMsg (all null [xs \\ ys, ys \\ xs]) where errorMsg = show ys ++ " is not a permutation of " ++ show xs -- | -- @action \`shouldReturn\` expected@ sets the expectation that @action@ -- returns @expected@. shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation action `shouldReturn` expected = action >>= (`shouldBe` expected) -- | -- 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 :: 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 -> (`assertBool` 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.5.0.1/src/Test/Hspec/Expectations/0000755000000000000000000000000012251063346021067 5ustar0000000000000000hspec-expectations-0.5.0.1/src/Test/Hspec/Expectations/Contrib.hs0000644000000000000000000000076212251063346023030 0ustar0000000000000000-- | -- 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 ( module Test.Hspec.Expectations -- * Predicates -- | (useful in combination with `shouldSatisfy`) , isLeft , isRight ) where import Test.Hspec.Expectations isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True