{-# 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

-- * Annotating expectations
, annotate
) where

import Control.Exception
import Test.HUnit.Lang (HUnitFailure(..), FailureReason(..))

#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

-- |
-- If you have a test case that has multiple assertions, you can use the
-- 'annotate' function to provide a string message that will be attached to
-- the 'Expectation'.
--
-- @
-- describe "annotate" $ do
--   it "adds the message" $ do
--     annotate "obvious falsehood" $ do
--       True `shouldBe` False
--
-- ========>
--
-- 1) annotate, adds the message
--       obvious falsehood
--       expected: False
--        but got: True
-- @
--
-- @since 0.8.3
annotate :: String -> IO a -> IO a
annotate :: forall a. String -> IO a -> IO a
annotate String
message = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a b. (a -> b) -> a -> b
$ \ (HUnitFailure Maybe SrcLoc
loc FailureReason
reason) -> forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
loc forall a b. (a -> b) -> a -> b
$ case FailureReason
reason of
  Reason String
err -> String -> FailureReason
Reason forall a b. (a -> b) -> a -> b
$ String -> String
addMessage String
err
  ExpectedButGot Maybe String
err String
expected String
got -> Maybe String -> String -> String -> FailureReason
ExpectedButGot (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
message String -> String
addMessage Maybe String
err) String
expected String
got
  where
    addMessage :: String -> String
addMessage String
err
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
err = String
message
      | Bool
otherwise = String
message forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
err