diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Greg V +Copyright (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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hspec-expectations-pretty-diff.cabal b/hspec-expectations-pretty-diff.cabal new file mode 100644 --- /dev/null +++ b/hspec-expectations-pretty-diff.cabal @@ -0,0 +1,55 @@ +name: hspec-expectations-pretty-diff +version: 0.7.2.1 +synopsis: Catchy combinators for HUnit +description: Catchy combinators for HUnit: +bug-reports: https://github.com/myfreeweb/hspec-expectations-pretty-diff/issues +license: MIT +license-file: LICENSE +copyright: (c) 2011-2015 Simon Hengel +author: Simon Hengel +maintainer: greg@unrelenting.technology +build-type: Simple +category: Testing +cabal-version: >= 1.10 +homepage: https://github.com/myfreeweb/hspec-expectations-pretty-diff#readme + +source-repository head + type: git + location: https://github.com/myfreeweb/hspec-expectations-pretty-diff + +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base == 4.* + , HUnit + , text + , hindent + , haskell-src-exts + , hscolour + , Diff + , ansi-terminal + exposed-modules: + Test.Hspec.Expectations + Test.Hspec.Expectations.Contrib + Test.Hspec.Expectations.Matcher + default-language: Haskell2010 + +test-suite tests + build-depends: + base >= 4.0.0.0 && < 5 + , hspec-expectations-pretty-diff + , HUnit + , aeson + , text + , hspec + default-language: Haskell2010 + ghc-options: -threaded -Wall + hs-source-dirs: + test + main-is: Spec.hs + other-modules: + Test.Hspec.ExpectationsSpec + Test.Hspec.Expectations.MatcherSpec + type: exitcode-stdio-1.0 diff --git a/src/Test/Hspec/Expectations.hs b/src/Test/Hspec/Expectations.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Expectations.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +#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 Prelude hiding (exp) +import qualified Test.HUnit +import Control.Exception +import Data.Typeable +import Data.List +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB +import Data.Algorithm.Diff (getDiff, Diff(..)) + +import Language.Haskell.HsColour hiding (layout) +import Language.Haskell.HsColour.Colourise (defaultColourPrefs) +import Language.Haskell.HsColour.ANSI (TerminalType(..)) +import Language.Haskell.Exts.Annotated.Syntax +import HIndent +import HIndent.Pretty +import HIndent.Types +import qualified HIndent.Styles.ChrisDone as S +import System.Console.ANSI + +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` + +hspecStyle :: Style +hspecStyle = + Style { styleName = T.empty + , styleAuthor = T.empty + , styleDescription = T.empty + , styleInitialState = S.State + , styleExtenders = [ Extender exp, Extender S.fieldupdate, Extender S.rhs ] + , styleDefConfig = defaultConfig { configMaxColumns = 80, configIndentSpaces = 2 } + , styleCommentPreprocessor = return } + where exp :: Exp NodeInfo -> Printer t () + exp (List _ es) = brackets' $ prefixedLined ", " $ map pretty es + exp (Tuple _ boxed exps) = + depend (write (case boxed of + Unboxed -> "(# " + Boxed -> "( ")) + (do prefixedLined ", " (map pretty exps) + write (case boxed of + Unboxed -> " #)" + Boxed -> " )")) + exp e = S.exp e + brackets' p = + depend (write "[ ") + (do v <- p + write " ]" + return v) + +prettyColor :: Show a => a -> String +prettyColor = hscolour' . hindent' . show + where hscolour' = hscolour (TTYg Ansi16Colour) defaultColourPrefs False False "" False + hindent' x = case reformat hspecStyle Nothing $ TL.pack x of + Right b -> TL.unpack $ TLB.toLazyText b + Left _ -> x + +diffColor :: String -> String -> String +diffColor x y = unlines $ map addSign $ getDiff (lines x) (lines y) + where addSign (Both _ s) = " " ++ s + addSign (First s) = color Red "---" ++ s + addSign (Second s) = color Green "+++" ++ s + color c s = setSGRCode [SetColor Foreground Dull c] ++ s ++ setSGRCode [Reset] + +-- | +-- @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 (diffColor (prettyColor expected) (prettyColor 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 diff --git a/src/Test/Hspec/Expectations/Contrib.hs b/src/Test/Hspec/Expectations/Contrib.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Expectations/Contrib.hs @@ -0,0 +1,26 @@ +{-# 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 diff --git a/src/Test/Hspec/Expectations/Matcher.hs b/src/Test/Hspec/Expectations/Matcher.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Expectations/Matcher.hs @@ -0,0 +1,26 @@ +module 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) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Test/Hspec/Expectations/MatcherSpec.hs b/test/Test/Hspec/Expectations/MatcherSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/Expectations/MatcherSpec.hs @@ -0,0 +1,34 @@ +module 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]" + ] diff --git a/test/Test/Hspec/ExpectationsSpec.hs b/test/Test/Hspec/ExpectationsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/ExpectationsSpec.hs @@ -0,0 +1,119 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +module Test.Hspec.ExpectationsSpec (spec) where + +import Control.Exception +import Test.HUnit.Lang +import Test.Hspec (Spec, describe, it) +import Data.Aeson +import Data.Text (pack) + +import Test.Hspec.Expectations + +deriving instance Eq HUnitFailure + +expectationFailed :: String -> HUnitFailure -> Bool +expectationFailed msg e = e == HUnitFailure msg + +data TestStructure = TestStructure { name :: String, number :: Int, children :: [TestStructure] } + deriving (Show, Eq) + +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 "\ESC[31m---\ESC[0m\ESC[35m\"bar\"\ESC[0m\n\ESC[32m+++\ESC[0m\ESC[35m\"foo\"\ESC[0m\n" + ([ TestStructure "outer" 123 [ TestStructure "inner" 456 [] ] ] `shouldBe` [ TestStructure "outer" 123 [ TestStructure "inner" 457 [] ] ]) `shouldThrow` expectationFailed " \ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[0mTestStructure\ESC[0m\ESC[0m \ESC[0m\ESC[36m{\ESC[0m\ESC[0mname\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"outer\"\ESC[0m\ESC[0m\n \ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0mnumber\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[35m123\ESC[0m\ESC[0m\n \ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0mchildren\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[0m\n \ESC[0m\ESC[0m \ESC[0m\ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[0mTestStructure\ESC[0m\ESC[0m \ESC[0m\ESC[36m{\ESC[0m\ESC[0mname\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"inner\"\ESC[0m\ESC[0m\n\ESC[31m---\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0mnumber\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[35m457\ESC[0m\ESC[0m\n\ESC[32m+++\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0mnumber\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[35m456\ESC[0m\ESC[0m\n \ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0mchildren\ESC[0m\ESC[0m \ESC[0m\ESC[31m=\ESC[0m\ESC[0m \ESC[0m\ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m}\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m}\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\n" + (object [ pack "foo" .= object [ pack "bar" .= Number 123 ] ] `shouldBe` object [ pack "foo" .= object [ pack "bar" .= Number 234, pack "quux" .= Number 567 ] ]) `shouldThrow` expectationFailed " \ESC[0mObject\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0mfromList\ESC[0m\ESC[0m \ESC[0m\ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"foo\"\ESC[0m\ESC[0m\n\ESC[31m---\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[0mObject\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0mfromList\ESC[0m\ESC[0m \ESC[0m\ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"quux\"\ESC[0m\ESC[0m\n\ESC[31m---\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[0mNumber\ESC[0m\ESC[0m \ESC[0m\ESC[35m567.0\ESC[0m\ESC[0m \ESC[0m\ESC[36m)\ESC[0m\ESC[0m\n\ESC[31m---\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"bar\"\ESC[0m\ESC[0m\n\ESC[31m---\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[0mNumber\ESC[0m\ESC[0m \ESC[0m\ESC[35m234.0\ESC[0m\ESC[0m \ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m)\ESC[0m\n\ESC[32m+++\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[0mObject\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0mfromList\ESC[0m\ESC[0m \ESC[0m\ESC[31m[\ESC[0m\ESC[0m \ESC[0m\ESC[36m(\ESC[0m\ESC[0m \ESC[0m\ESC[35m\"bar\"\ESC[0m\ESC[0m\n\ESC[32m+++\ESC[0m\ESC[0m\ESC[0m \ESC[0m\ESC[36m,\ESC[0m\ESC[0m \ESC[0m\ESC[0mNumber\ESC[0m\ESC[0m \ESC[0m\ESC[35m123.0\ESC[0m\ESC[0m \ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[36m)\ESC[0m\ESC[0m \ESC[0m\ESC[31m]\ESC[0m\ESC[36m)\ESC[0m\n" + + 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 "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 "\ESC[31m---\ESC[0m\ESC[35m\"bar\"\ESC[0m\n\ESC[32m+++\ESC[0m\ESC[35m\"foo\"\ESC[0m\n" + + 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 "\"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 "\"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 "\"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 "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 "predicate succeded 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 "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 "\"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 "predicate failed on expected exception: ArithException (arithmetic overflow)" + + it "fails, if any exception is required, but no exception occurs" $ do + (return () `shouldThrow` anyException) `shouldThrow` expectationFailed "did not get expected exception: SomeException" + + it "fails, if a required exception of a specific type is not thrown" $ do + (return () `shouldThrow` anyErrorCall) `shouldThrow` expectationFailed "did not get expected exception: ErrorCall" + + it "fails, if a required specific exception is not thrown" $ do + (error "foo" `shouldThrow` errorCall "foobar") `shouldThrow` expectationFailed "predicate failed on expected exception: ErrorCall (foo)"