content: {-# OPTIONS_GHC -cpp -pgmP "cpphs --layout --hashes --cpp" #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE BangPatterns #-}
  
  --
  -- Copyright (c) 2005-2022  Stefan Wehr - http://www.stefanwehr.de
  --
  -- This library is free software; you can redistribute it and/or
  -- modify it under the terms of the GNU Lesser General Public
  -- License as published by the Free Software Foundation; either
  -- version 2.1 of the License, or (at your option) any later version.
  --
  -- This library is distributed in the hope that it will be useful,
  -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  -- Lesser General Public License for more details.
  --
  -- You should have received a copy of the GNU Lesser General Public
  -- License along with this library; if not, write to the Free Software
  -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
  --
  
  {-|
  
  This module provides assert-like functions for writing unit tests.
  
  -}
  
  module Test.Framework.HUnitWrapper (
  
    -- * Assertions on Bool values
    assertBool, assertBoolVerbose,
  
    -- * Equality assertions
    assertEqual, assertEqualVerbose,
    assertEqualPretty, assertEqualPrettyVerbose,
    assertEqualNoShow, assertEqualNoShowVerbose,
  
    -- * Inequality assertions
    assertNotEqual, assertNotEqualVerbose,
    assertNotEqualPretty, assertNotEqualPrettyVerbose,
    assertNotEqualNoShow, assertNotEqualNoShowVerbose,
  
    -- * Assertions on lists
    assertListsEqualAsSets, assertListsEqualAsSetsVerbose,
    assertNotEmpty, assertNotEmptyVerbose,
    assertEmpty, assertEmptyVerbose,
    assertElem, assertElemVerbose,
  
    -- * Assertions for exceptions
    assertThrows, assertThrowsVerbose,
    assertThrowsSome, assertThrowsSomeVerbose,
    assertThrowsIO, assertThrowsIOVerbose,
    assertThrowsSomeIO, assertThrowsSomeIOVerbose,
    assertThrowsM, assertThrowsMVerbose,
    assertThrowsSomeM, assertThrowsSomeMVerbose,
  
    -- * Assertions on Either values
    assertLeft, assertLeftVerbose,
    assertLeftNoShow, assertLeftNoShowVerbose,
    assertRight, assertRightVerbose,
    assertRightNoShow, assertRightNoShowVerbose,
  
    -- * Assertions on Just values
    assertJust, assertJustVerbose,
    assertNothing, assertNothingVerbose,
    assertNothingNoShow, assertNothingNoShowVerbose,
  
    -- * General failure
    assertFailure,
  
    -- * Pending unit tests
    unitTestPending, unitTestPending',
  
    -- * Sub assertions
    subAssert, subAssertVerbose,
  
    -- * Generalized assertions and failures in AssertM
    {- |
         The following definitions generalize the the monad in which assertions are executed.
         Usually, assertions are executed in the @IO@ monad. The @AssertM@ monad
         (see "Test.Framework.AssertM") allows you to evaluate assertions also as pure functions.
     -}
    -- ** Assertions on Bool values
    gassertBool, gassertBoolVerbose,
  
    -- ** Equality assertions
    gassertEqual, gassertEqualVerbose,
    gassertEqualPretty, gassertEqualPrettyVerbose,
    gassertEqualNoShow, gassertEqualNoShowVerbose,
  
    -- ** Inequality assertions
    gassertNotEqual, gassertNotEqualVerbose,
    gassertNotEqualPretty, gassertNotEqualPrettyVerbose,
    gassertNotEqualNoShow, gassertNotEqualNoShowVerbose,
  
    -- ** Assertions on lists
    gassertListsEqualAsSets, gassertListsEqualAsSetsVerbose,
    gassertNotEmpty, gassertNotEmptyVerbose,
    gassertEmpty, gassertEmptyVerbose,
    gassertElem, gassertElemVerbose,
  
    -- ** Assertions on Either values
    gassertLeft, gassertLeftVerbose,
    gassertLeftNoShow, gassertLeftNoShowVerbose,
    gassertRight, gassertRightVerbose,
    gassertRightNoShow, gassertRightNoShowVerbose,
  
    -- ** Assertions on Just values
    gassertJust, gassertJustVerbose,
    gassertNothing, gassertNothingVerbose,
    gassertNothingNoShow, gassertNothingNoShowVerbose,
  
    -- ** General failure
    gassertFailure,
  
    -- ** Sub assertions
    gsubAssert, gsubAssertVerbose,
  
    -- * HUnit re-exports
    HU.HUnitFailure,
  
    -- * Tests (for internal use)
    hunitWrapperTests
  
  ) where
  
  import Control.Exception
  import qualified Control.Exception.Lifted as ExL
  import Control.Monad.Trans.Control
  import Control.Monad.Trans
  import qualified Test.HUnit.Lang as HU
  #if !MIN_VERSION_HUnit(1,4,0)
  import qualified Test.HUnit.Base as HU
  #endif
  
  import GHC.Stack
  
  import Data.List ( (\\) )
  import System.IO.Unsafe (unsafePerformIO)
  
  import Test.Framework.TestInterface
  import Test.Framework.Location
  import Test.Framework.Diff
  import Test.Framework.Colors
  import Test.Framework.Pretty
  import Test.Framework.AssertM
  import Test.Framework.PrettyHaskell
  import Test.Framework.Utils
  
  import qualified Data.Text as T
  import qualified Data.List as List
  
  -- WARNING: do not forget to add a preprocessor macro for new assertions!!
  
  {- |
  Fail with the given reason in some 'AssertM' monad.
  -}
  gassertFailure :: (HasCallStack, AssertM m) => String -> m a
  gassertFailure s =
      genericAssertFailure (mkMsg "assertFailure" "" s)
  
  -- | Specialization of 'gassertFailure' to @IO@.
  assertFailure :: HasCallStack => String -> IO a
  assertFailure = gassertFailure
  
  {- |
  Signals that the current unit test is pending.
  -}
  unitTestPending :: String -> IO a
  unitTestPending s =
      failHTF (FullTestResult emptyHtfStack (Just $ noColor s) (Just Pending))
  
  {- |
  Use @unitTestPending' msg test@ to mark the given test as pending
  without removing it from the test suite and without deleting or commenting out the test code.
  -}
  unitTestPending' :: String -> IO a -> IO a
  unitTestPending' msg _ = unitTestPending msg
  
  mkMsg :: String -> String -> String -> ColorString
  mkMsg s1 s2 s3 = mkColorMsg s1 s2 (noColor s3)
  
  mkColorMsg :: String -> String -> ColorString -> ColorString
  mkColorMsg fun extraInfo s =
      let pref = if null extraInfo
                 then fun ++ " "
                 else fun ++ " (" ++ extraInfo ++ ") "
      in noColor pref +++ s
  
  --
  -- Boolean Assertions
  --
  
  assertBool_ :: (HasCallStack, AssertM m) => String -> String -> Bool -> m ()
  assertBool_ name s False = genericAssertFailure (mkMsg name s "failed")
  assertBool_ _ _ True = return ()
  
  -- | Fail if the 'Bool' value is 'False'.
  assertBool :: HasCallStack => Bool -> IO ()
  assertBool = assertBool_ "assertBool" ""
  
  assertBoolVerbose :: HasCallStack => String -> Bool -> IO ()
  assertBoolVerbose = assertBool_ "assertBoolVerbose"
  
  gassertBool :: (HasCallStack, AssertM m) => Bool -> m ()
  gassertBool = assertBool_ "gassertBool" ""
  
  gassertBoolVerbose :: (HasCallStack, AssertM m) => String -> Bool -> m ()
  gassertBoolVerbose = assertBool_ "gassertBoolVerbose"
  
  --
  -- Equality Assertions
  --
  
  equalityFailedMessage' :: String -> String -> ColorString
  equalityFailedMessage' exp act =
      let !diff = unsafePerformIO (diffWithSensibleConfig exp act)
          expected_ = colorize firstDiffColor "* expected:"
          but_got_ = colorize secondDiffColor "* but got:"
          diff_ = colorize diffColor "* diff:"
      in ("\n" +++ expected_ +++ " " +++ noColor (withNewline (trim exp)) +++
          "\n" +++ but_got_ +++ "  " +++ noColor (withNewline (trim act)) +++
          "\n" +++ diff_ +++ "     " +++ newlineBeforeDiff diff +++ diff +++
          (if (exp == act)
           then "\nWARNING: strings are equal but actual values differ!"
           else ""))
      where
        withNewline s =
            case lines s of
              [] -> s
              [_] -> s
              _ -> '\n':s
        newlineBeforeDiff d =
            let f b = case colorStringFind (\c -> c == '\n') d b of
                        Just _ -> "\n"
                        Nothing -> ""
            in noColor' (f True) (f False)
        trim s =
            case List.splitAt maxLen s of
              (_, []) -> s
              (prefix, rest) ->
                  prefix ++ " (removed " ++ show (length rest) ++ " trailing chars)"
        maxLen = 10000
  
  asString :: Show a => a -> Maybe String
  asString x = readM (show x)
  
  equalityFailedMessage :: (Show a) => a -> a -> ColorString
  equalityFailedMessage exp act =
      equalityFailedMessage' expP actP
      where
        (expP, actP) =
          case (asString exp, asString act) of
            (Just expS, Just actS)
              | expS /= actS -> (expS, actS)
            _ ->
              case (prettyHaskell' exp, prettyHaskell' act) of
                (Nothing, _) -> (show exp, show act)
                (_, Nothing) -> (show exp, show act)
                (Just expP, Just actP)
                    | expP == actP ->
                        (show exp, show act)
                    | otherwise -> (expP, actP)
  
  notEqualityFailedMessage :: Show a => a -> String
  notEqualityFailedMessage exp =
      notEqualityFailedMessage' (prettyHaskell exp)
  
  notEqualityFailedMessage' :: String -> String
  notEqualityFailedMessage' exp =
      (": Objects are equal\n" ++ exp)
  
  failedAt :: HasCallStack => String
  failedAt =
    case failureLocation of
      Nothing -> "failed"
      Just loc -> "failed at " ++ showLoc loc
  
  assertEqual_ :: (Eq a, Show a, AssertM m, HasCallStack)
                   => String -> String -> a -> a -> m ()
  assertEqual_ name s expected actual =
      if expected /= actual
         then do let x = equalityFailedMessage expected actual
                 genericAssertFailure (mkColorMsg name s $
                                        noColor failedAt +++ x)
         else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  gassertEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertEqualVerbose = assertEqual_ "gassertEqualVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  gassertEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertEqual = assertEqual_ "gassertEqual" ""
  
  -- | Fail if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  assertEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO ()
  assertEqualVerbose = assertEqual_ "assertEqualVerbose"
  
  -- | Fail if the two values of type @a@ are not equal.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  assertEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO ()
  assertEqual = assertEqual_ "assertEqual" ""
  
  assertNotEqual_ :: (Eq a, Show a, AssertM m, HasCallStack)
                  => String -> String -> a -> a -> m ()
  assertNotEqual_ name s expected actual =
      if expected == actual
         then do let x = notEqualityFailedMessage expected
                 genericAssertFailure (mkMsg name s $ failedAt ++ x)
         else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  gassertNotEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertNotEqualVerbose = assertNotEqual_ "gassertNotEqualVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  gassertNotEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertNotEqual = assertNotEqual_ "gassertNotEqual" ""
  
  -- | Fail if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  assertNotEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO ()
  assertNotEqualVerbose = assertNotEqual_ "assertNotEqualVerbose"
  
  -- | Fail if the two values of type @a@ are equal.
  -- Use if @a@ is an instance of 'Show' but not of 'Pretty'.
  assertNotEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO ()
  assertNotEqual = assertNotEqual_ "assertNotEqual" ""
  
  assertEqualPretty_ :: (Eq a, Pretty a, AssertM m, HasCallStack)
                     => String -> String -> a -> a -> m ()
  assertEqualPretty_ name s expected actual =
      if expected /= actual
         then do let x = equalityFailedMessage' (showPretty expected) (showPretty actual)
                 genericAssertFailure (mkColorMsg name s
                                        (noColor failedAt +++ x))
         else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Pretty'.
  gassertEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertEqualPrettyVerbose = assertEqualPretty_ "gassertEqualPrettyVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal.
  -- Use if @a@ is an instance of 'Pretty'.
  gassertEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertEqualPretty = assertEqualPretty_ "gassertEqualPretty" ""
  
  -- | Fail if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Pretty'.
  assertEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO ()
  assertEqualPrettyVerbose = assertEqualPretty_ "assertEqualPrettyVerbose"
  
  -- | Fail if the two values of type @a@ are not equal.
  -- Use if @a@ is an instance of 'Pretty'.
  assertEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
  assertEqualPretty = assertEqualPretty_ "assertEqualPretty" ""
  
  assertNotEqualPretty_ :: (Eq a, Pretty a, AssertM m, HasCallStack)
                         => String -> String -> a -> a -> m ()
  assertNotEqualPretty_ name s expected actual =
      if expected == actual
         then do let x = notEqualityFailedMessage' (showPretty expected)
                 genericAssertFailure (mkMsg name s $ failedAt ++ x)
         else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Pretty'.
  gassertNotEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertNotEqualPrettyVerbose = assertNotEqualPretty_ "gassertNotEqualPrettyVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal.
  -- Use if @a@ is an instance of 'Pretty'.
  gassertNotEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertNotEqualPretty = assertNotEqualPretty_ "gassertNotEqualPretty" ""
  
  -- | Fail if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is an instance of 'Pretty'.
  assertNotEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO ()
  assertNotEqualPrettyVerbose = assertNotEqualPretty_ "assertNotEqualPrettyVerbose"
  
  -- | Fail if the two values of type @a@ are equal.
  -- Use if @a@ is an instance of 'Pretty'.
  assertNotEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
  assertNotEqualPretty = assertNotEqualPretty_ "assertNotEqualPretty" ""
  
  assertEqualNoShow_ :: (Eq a, AssertM m, HasCallStack)
                      => String -> String -> a -> a -> m ()
  assertEqualNoShow_ name s expected actual =
      if expected /= actual
      then genericAssertFailure (mkMsg name s failedAt)
      else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  gassertEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertEqualNoShowVerbose = assertEqualNoShow_ "gassertEqualNoShowVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are not equal.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  gassertEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertEqualNoShow = assertEqualNoShow_ "gassertEqualNoShow" ""
  
  -- | Fail if the two values of type @a@ are not equal, supplying
  -- an additional message.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  assertEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO ()
  assertEqualNoShowVerbose = assertEqualNoShow_ "assertEqualNoShowVerbose"
  
  -- | Fail if the two values of type @a@ are not equal.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  assertEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO ()
  assertEqualNoShow = assertEqualNoShow_ "assertEqualNoShow" ""
  
  assertNotEqualNoShow_ :: (Eq a, AssertM m, HasCallStack)
                        => String -> String -> a -> a -> m ()
  assertNotEqualNoShow_ name s expected actual =
      if expected == actual
         then genericAssertFailure (mkMsg name s failedAt)
         else return ()
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  gassertNotEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m ()
  gassertNotEqualNoShowVerbose = assertNotEqualNoShow_ "gassertNotEqualNoShowVerbose"
  
  -- | Fail in some 'AssertM' monad if the two values of type @a@ are equal.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  gassertNotEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m ()
  gassertNotEqualNoShow = assertNotEqualNoShow_ "gassertNotEqualNoShow" ""
  
  -- | Fail if the two values of type @a@ are equal, supplying
  -- an additional message.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  assertNotEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO ()
  assertNotEqualNoShowVerbose = assertNotEqualNoShow_ "assertNotEqualNoShowVerbose"
  
  -- | Fail if the two values of type @a@ are equal.
  -- Use if @a@ is neither an instance of 'Show' nor of 'Pretty'.
  assertNotEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO ()
  assertNotEqualNoShow = assertNotEqualNoShow_ "assertNotEqualNoShow" ""
  
  --
  -- Assertions on Lists
  --
  
  assertListsEqualAsSets_ :: (Eq a, Show a, AssertM m, HasCallStack)
                     => String -> String -> [a] -> [a] -> m ()
  assertListsEqualAsSets_ name s expected actual =
      let ne = length expected
          na = length actual
          in case () of
              _| ne /= na ->
                   do let x = equalityFailedMessage expected actual
                      genericAssertFailure (mkColorMsg name s
                                             (noColor
                                               (failedAt
                                                 ++ "\n expected length: " ++ show ne
                                                 ++ "\n actual length: " ++ show na) +++
                                               (if maxLength x < 5000
                                                 then x else emptyColorString)))
               | not (unorderedEq expected actual) ->
                   do let x = equalityFailedMessage expected actual
                      genericAssertFailure (mkColorMsg "assertSetEqual" s
                                             (noColor failedAt +++ x))
               | otherwise -> return ()
      where unorderedEq l1 l2 =
                null (l1 \\ l2) && null (l2 \\ l1)
  
  -- | Fail in some 'AssertM' monad if the two given lists are not equal when considered as sets,
  -- supplying an additional error message.
  gassertListsEqualAsSetsVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> [a] -> [a] -> m ()
  gassertListsEqualAsSetsVerbose = assertListsEqualAsSets_ "gassertListsEqualAsSetsVerbose"
  
  -- | Fail in some 'AssertM' monad if the two given lists are not equal when considered as sets.
  gassertListsEqualAsSets :: (Eq a, Show a, AssertM m, HasCallStack) => [a] -> [a] -> m ()
  gassertListsEqualAsSets= assertListsEqualAsSets_ "gassertListsEqualAsSets" ""
  
  -- | Fail if the two given lists are not equal when considered as sets,
  -- supplying an additional error message.
  assertListsEqualAsSetsVerbose :: (Eq a, Show a, HasCallStack) => String -> [a] -> [a] -> IO ()
  assertListsEqualAsSetsVerbose = assertListsEqualAsSets_ "assertListsEqualAsSetsVerbose"
  
  -- | Fail if the two given lists are not equal when considered as sets.
  assertListsEqualAsSets :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> IO ()
  assertListsEqualAsSets = assertListsEqualAsSets_ "assertListsEqualAsSets" ""
  
  assertNotEmpty_ :: (AssertM m, HasCallStack) => String -> String -> [a] -> m ()
  assertNotEmpty_ name s [] =
      genericAssertFailure (mkMsg name s failedAt)
  assertNotEmpty_ _ _ (_:_) = return ()
  
  -- | Fail in some 'AssertM' monad if the given list is empty, supplying an
  -- additional error message.
  gassertNotEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m ()
  gassertNotEmptyVerbose = assertNotEmpty_ "gassertNotEmptyVerbose"
  
  -- | Fail in some 'AssertM' monad if the given list is empty.
  gassertNotEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
  gassertNotEmpty = assertNotEmpty_ "gassertNotEmpty" ""
  
  -- | Fail if the given list is empty, supplying an
  -- additional error message.
  assertNotEmptyVerbose ::  HasCallStack => String -> [a] -> IO ()
  assertNotEmptyVerbose = assertNotEmpty_ "assertNotEmptyVerbose"
  
  -- | Fail if the given list is empty.
  assertNotEmpty ::  HasCallStack => [a] -> IO ()
  assertNotEmpty = assertNotEmpty_ "assertNotEmpty" ""
  
  assertEmpty_ :: (AssertM m, HasCallStack) => String -> String -> [a] -> m ()
  assertEmpty_ name s (_:_) =
      genericAssertFailure (mkMsg name s failedAt)
  assertEmpty_ _ _ [] = return ()
  
  -- | Fail in some 'AssertM' monad if the given list is not empty, supplying an
  -- additional error message.
  gassertEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m ()
  gassertEmptyVerbose = assertEmpty_ "gassertEmptyVerbose"
  
  -- | Fail in some 'AssertM' monad if the given list is not empty.
  gassertEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
  gassertEmpty = assertEmpty_ "gassertEmpty" ""
  
  -- | Fail if the given list is not empty, supplying an
  -- additional error message.
  assertEmptyVerbose ::  HasCallStack => String -> [a] -> IO ()
  assertEmptyVerbose = assertEmpty_ "assertEmptyVerbose"
  
  -- | Fail if the given list is not empty.
  assertEmpty ::  HasCallStack => [a] -> IO ()
  assertEmpty = assertEmpty_ "assertEmpty" ""
  
  assertElem_ :: (Eq a, Show a, AssertM m, HasCallStack) => String -> String -> a -> [a] -> m ()
  assertElem_ name s x l =
      if x `elem` l
      then return ()
      else genericAssertFailure (mkMsg name s
                                  (failedAt ++
                                    "\n element: " ++ show x ++
                                    "\n list:   " ++ show l))
  
  -- | Fail in some 'AssertM' monad if the element given is not contained in the list, supplying
  -- an additional error message.
  gassertElemVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> [a] -> m ()
  gassertElemVerbose = assertElem_ "gassertElemVerbose"
  
  -- | Fail in some 'AssertM' monad if the element given is not contained in the list.
  gassertElem :: (Eq a, Show a, AssertM m, HasCallStack) => a -> [a] -> m ()
  gassertElem = assertElem_ "gassertElem" ""
  
  -- | Fail if the element given is not contained in the list, supplying
  -- an additional error message.
  assertElemVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> [a] -> IO ()
  assertElemVerbose = assertElem_ "assertElemVerbose"
  
  -- | Fail if the element given is not contained in the list.
  assertElem :: (Eq a, Show a, HasCallStack) => a -> [a] -> IO ()
  assertElem = assertElem_ "assertElem" ""
  
  --
  -- Assertions for Exceptions
  --
  
  assertThrowsIO_ :: (HasCallStack, Exception e)
                   => String -> String -> IO a -> (e -> Bool) -> IO ()
  assertThrowsIO_ name s x f =
      assertThrowsM_ name s x f
  
  -- | Fail if executing the 'IO' action does not throw an exception satisfying the given predicate
  -- @(e -> Bool)@, supplying an additional error message.
  assertThrowsIOVerbose :: (HasCallStack, Exception e) => String -> IO a -> (e -> Bool) -> IO ()
  assertThrowsIOVerbose = assertThrowsIO_ "assertThrowsIOVerbose"
  
  -- | Fail if executing the 'IO' action does not throw an exception satisfying the given predicate
  -- @(e -> Bool)@.
  assertThrowsIO :: (HasCallStack, Exception e) => IO a -> (e -> Bool) -> IO ()
  assertThrowsIO = assertThrowsIO_ "assertThrowsIO" ""
  
  assertThrowsSomeIO_ :: HasCallStack => String -> String -> IO a -> IO ()
  assertThrowsSomeIO_ name s x = assertThrowsIO_ name s x (\ (_e::SomeException) -> True)
  
  -- | Fail if executing the 'IO' action does not throw any exception,
  -- supplying an additional error message.
  assertThrowsSomeIOVerbose ::  HasCallStack => String -> IO a -> IO ()
  assertThrowsSomeIOVerbose = assertThrowsSomeIO_ "assertThrowsSomeIOVerbose"
  
  -- | Fail if executing the 'IO' action does not throw any exception.
  assertThrowsSomeIO :: HasCallStack => IO a -> IO ()
  assertThrowsSomeIO = assertThrowsSomeIO_ "assertThrowsSomeIO" ""
  
  assertThrowsM_ :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack)
                  => String -> String -> m a -> (e -> Bool) -> m ()
  assertThrowsM_ name s x f =
      do res <- ExL.try x
         case res of
           Right _ -> liftIO $
                      genericAssertFailure (mkMsg name s
                                             (failedAt ++
                                               ": no exception was thrown"))
           Left e -> if f e then return ()
                     else liftIO $
                          genericAssertFailure (mkMsg name s
                                                 (failedAt ++
                                                   ": wrong exception was thrown: " ++
                                                   show e))
  -- | Fail if executing the @m@ action does not throw an exception satisfying the given predicate
  -- @(e -> Bool)@, supplying an additional error message.
  assertThrowsMVerbose ::
    (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack)
    => String -> m a -> (e -> Bool) -> m ()
  assertThrowsMVerbose = assertThrowsM_ "assertThrowsMVerbose"
  
  -- | Fail if executing the @m@ action does not throw an exception satisfying the given predicate
  -- @(e -> Bool)@.
  assertThrowsM ::
    (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack)
    => m a -> (e -> Bool) -> m ()
  assertThrowsM = assertThrowsM_ "assertThrowsM" ""
  
  assertThrowsSomeM_ :: (MonadBaseControl IO m, MonadIO m, HasCallStack)
                      => String -> String -> m a -> m ()
  assertThrowsSomeM_ name s x = assertThrowsM_ name s x (\ (_e::SomeException) -> True)
  
  -- | Fail if executing the @m@ action does not throw any exception,
  -- supplying an additional error message.
  assertThrowsSomeMVerbose ::
    (MonadBaseControl IO m, MonadIO m, HasCallStack)
    => String -> m a -> m ()
  assertThrowsSomeMVerbose = assertThrowsSomeM_ "assertThrowsSomeMVerbose"
  
  -- | Fail if executing the @m@ action does not throw any exception.
  assertThrowsSomeM :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => m a -> m ()
  assertThrowsSomeM = assertThrowsSomeM_ "assertThrowsSomeM" ""
  
  assertThrows_ :: (HasCallStack, Exception e)
                 => String -> String -> a -> (e -> Bool) -> IO ()
  assertThrows_ name s x f = assertThrowsIO_ name s (evaluate x) f
  
  -- | Fail if evaluating the expression of type @a@ does not
  -- throw an exception satisfying the given predicate @(e -> Bool)@,
  -- supplying an additional error message.
  assertThrowsVerbose :: (HasCallStack, Exception e) => String -> a -> (e -> Bool) -> IO ()
  assertThrowsVerbose = assertThrows_ "assertThrowsVerbose"
  
  -- | Fail if evaluating the expression of type @a@ does not
  -- throw an exception satisfying the given predicate @(e -> Bool)@.
  assertThrows :: (HasCallStack, Exception e) => a -> (e -> Bool) -> IO ()
  assertThrows = assertThrows_ "assertThrows" ""
  
  assertThrowsSome_ :: HasCallStack => String -> String -> a -> IO ()
  assertThrowsSome_ name s x =
      assertThrows_ name s x (\ (_e::SomeException) -> True)
  
  -- | Fail if evaluating the expression of type @a@ does not
  -- throw any exception, supplying an additional error message.
  assertThrowsSomeVerbose :: HasCallStack => String -> a -> IO ()
  assertThrowsSomeVerbose = assertThrowsSome_ "assertThrowsSomeVerbose"
  
  -- | Fail if evaluating the expression of type @a@ does not
  -- throw any exception.
  assertThrowsSome ::  HasCallStack => a -> IO ()
  assertThrowsSome = assertThrowsSome_ "assertThrowsSome" ""
  
  --
  -- Assertions on Either
  --
  
  assertLeft_ :: forall a b m . (AssertM m, Show b, HasCallStack)
               => String -> String -> Either a b -> m a
  assertLeft_ _ _ (Left x) = return x
  assertLeft_ name s (Right x) =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected a Left value, given " ++
                               show (Right x :: Either b b)))
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Right',
  -- supplying an additional error message.
  -- Use this function if @b@ is an instance of 'Show'.
  gassertLeftVerbose :: (Show b, AssertM m, HasCallStack) => String -> Either a b -> m a
  gassertLeftVerbose = assertLeft_ "gassertLeftVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Right'.
  -- Use this function if @b@ is an instance of 'Show'.
  gassertLeft :: (Show b, AssertM m, HasCallStack) => Either a b -> m a
  gassertLeft = assertLeft_ "gassertLeft" ""
  
  -- | Fail if the given @Either a b@ value is a 'Right',
  -- supplying an additional error message.
  -- Use this function if @b@ is an instance of 'Show'.
  assertLeftVerbose :: (Show b, HasCallStack) => String -> Either a b -> IO a
  assertLeftVerbose = assertLeft_ "assertLeftVerbose"
  
  -- | Fail if the given @Either a b@ value is a 'Right'.
  -- Use this function if @b@ is an instance of 'Show'.
  assertLeft :: (HasCallStack, Show b) => Either a b -> IO a
  assertLeft = assertLeft_ "assertLeft" ""
  
  assertLeftNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Either a b -> m a
  assertLeftNoShow_ _ _ (Left x) = return x
  assertLeftNoShow_ name s (Right _) =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected a Left value, given a Right value"))
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Right',
  -- supplying an additional error message.
  -- Use this function if @b@ is not an instance of 'Show'.
  gassertLeftNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m a
  gassertLeftNoShowVerbose = assertLeftNoShow_ "gassertLeftNoShowVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Right'.
  -- Use this function if @b@ is not an instance of 'Show'.
  gassertLeftNoShow :: (HasCallStack, AssertM m) => Either a b -> m a
  gassertLeftNoShow = assertLeftNoShow_ "gassertLeftNoShow" ""
  
  -- | Fail if the given @Either a b@ value is a 'Right',
  -- supplying an additional error message.
  -- Use this function if @b@ is not an instance of 'Show'.
  assertLeftNoShowVerbose ::  HasCallStack => String -> Either a b -> IO a
  assertLeftNoShowVerbose = assertLeftNoShow_ "assertLeftNoShowVerbose"
  
  -- | Fail if the given @Either a b@ value is a 'Right'.
  -- Use this function if @b@ is not an instance of 'Show'.
  assertLeftNoShow :: HasCallStack => Either a b -> IO a
  assertLeftNoShow = assertLeftNoShow_ "assertLeftNoShow" ""
  
  assertRight_ :: forall a b m . (AssertM m, Show a, HasCallStack)
               => String -> String -> Either a b -> m b
  assertRight_ _ _ (Right x) = return x
  assertRight_ name s (Left x) =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected a Right value, given " ++
                               show (Left x :: Either a a)))
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Left',
  -- supplying an additional error message.
  -- Use this function if @a@ is an instance of 'Show'.
  gassertRightVerbose :: (Show a, AssertM m, HasCallStack) => String -> Either a b -> m b
  gassertRightVerbose = assertRight_ "gassertRightVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Left'.
  -- Use this function if @a@ is an instance of 'Show'.
  gassertRight :: (Show a, AssertM m, HasCallStack) => Either a b -> m b
  gassertRight = assertRight_ "gassertRight" ""
  
  -- | Fail if the given @Either a b@ value is a 'Left',
  -- supplying an additional error message.
  -- Use this function if @a@ is an instance of 'Show'.
  assertRightVerbose :: (Show a, HasCallStack) => String -> Either a b -> IO b
  assertRightVerbose = assertRight_ "assertRightVerbose"
  
  -- | Fail if the given @Either a b@ value is a 'Left'.
  -- Use this function if @a@ is an instance of 'Show'.
  assertRight :: (HasCallStack, Show a) => Either a b -> IO b
  assertRight = assertRight_ "assertRight" ""
  
  assertRightNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Either a b -> m b
  assertRightNoShow_ _ _ (Right x) = return x
  assertRightNoShow_ name s (Left _) =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected a Right value, given a Left value"))
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Left',
  -- supplying an additional error message.
  -- Use this function if @a@ is not an instance of 'Show'.
  gassertRightNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m b
  gassertRightNoShowVerbose = assertRightNoShow_ "gassertRightNoShowVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Either a b@ value is a 'Left'.
  -- Use this function if @a@ is not an instance of 'Show'.
  gassertRightNoShow :: (HasCallStack, AssertM m) => Either a b -> m b
  gassertRightNoShow = assertRightNoShow_ "gassertRightNoShow" ""
  
  -- | Fail if the given @Either a b@ value is a 'Left',
  -- supplying an additional error message.
  -- Use this function if @a@ is not an instance of 'Show'.
  assertRightNoShowVerbose ::  HasCallStack => String -> Either a b -> IO b
  assertRightNoShowVerbose = assertRightNoShow_ "assertRightNoShowVerbose"
  
  -- | Fail if the given @Either a b@ value is a 'Left'.
  -- Use this function if @a@ is not an instance of 'Show'.
  assertRightNoShow :: HasCallStack => Either a b -> IO b
  assertRightNoShow = assertRightNoShow_ "assertRightNoShow" ""
  
  --
  -- Assertions on Maybe
  --
  
  assertJust_ :: (HasCallStack, AssertM m) => String -> String -> Maybe a -> m a
  assertJust_ _ _ (Just x) = return x
  assertJust_ name s Nothing =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected a Just value, given Nothing"))
  
  -- | Fail in some 'AssertM' monad if the given value is a Nothing, supplying an additional
  -- error message.
  gassertJustVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m a
  gassertJustVerbose = assertJust_ "gassertJustVerbose"
  
  -- | Fail in some 'AssertM' monad if the given value is a Nothing.
  gassertJust :: (HasCallStack, AssertM m) => Maybe a -> m a
  gassertJust = assertJust_ "gassertJust" ""
  
  -- | Fail if the given value is a Nothing, supplying an additional
  -- error message.
  assertJustVerbose :: HasCallStack => String -> Maybe a -> IO a
  assertJustVerbose = assertJust_ "assertJustVerbose"
  
  -- | Fail if the given value is a Nothing.
  assertJust :: HasCallStack => Maybe a -> IO a
  assertJust = assertJust_ "assertJust" ""
  
  assertNothing_ :: (Show a, AssertM m, HasCallStack)
                  => String -> String -> Maybe a -> m ()
  assertNothing_ _ _ Nothing = return ()
  assertNothing_ name s jx =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected Nothing, given " ++ show jx))
  
  -- | Fail in some 'AssertM' monad if the given @Maybe a@ value is a 'Just', supplying an additional
  -- error message.
  -- Use this function if @a@ is an instance of 'Show'.
  gassertNothingVerbose :: (Show a, AssertM m, HasCallStack) => String -> Maybe a -> m ()
  gassertNothingVerbose = assertNothing_ "gassertNothingVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Maybe a@ value is a 'Just'.
  -- Use this function if @a@ is an instance of 'Show'.
  gassertNothing :: (Show a, AssertM m, HasCallStack) => Maybe a -> m ()
  gassertNothing = assertNothing_ "gassertNothing" ""
  
  -- | Fail if the given @Maybe a@ value is a 'Just', supplying an additional
  -- error message.
  -- Use this function if @a@ is an instance of 'Show'.
  assertNothingVerbose :: (Show a, HasCallStack) => String -> Maybe a -> IO ()
  assertNothingVerbose = assertNothing_ "assertNothingVerbose"
  
  -- | Fail if the given @Maybe a@ value is a 'Just'.
  -- Use this function if @a@ is an instance of 'Show'.
  assertNothing :: (HasCallStack, Show a) => Maybe a -> IO ()
  assertNothing = assertNothing_ "assertNothing" ""
  
  assertNothingNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Maybe a -> m ()
  assertNothingNoShow_ _ _ Nothing = return ()
  assertNothingNoShow_ name s _ =
      genericAssertFailure (mkMsg name s
                             (failedAt ++
                               ": expected Nothing, given a Just value"))
  
  -- | Fail in some 'AssertM' monad if the given @Maybe a@ value is a 'Just', supplying an additional
  -- error message.
  -- Use this function if @a@ is not an instance of 'Show'.
  gassertNothingNoShowVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m ()
  gassertNothingNoShowVerbose = assertNothingNoShow_ "gassertNothingNoShowVerbose"
  
  -- | Fail in some 'AssertM' monad if the given @Maybe a@ value is a 'Just'.
  -- Use this function if @a@ is not an instance of 'Show'.
  gassertNothingNoShow :: (HasCallStack, AssertM m) => Maybe a -> m ()
  gassertNothingNoShow = assertNothingNoShow_ "gassertNothingNoShow" ""
  
  -- | Fail if the given @Maybe a@ value is a 'Just', supplying an additional
  -- error message.
  -- Use this function if @a@ is not an instance of 'Show'.
  assertNothingNoShowVerbose :: HasCallStack => String -> Maybe a -> IO ()
  assertNothingNoShowVerbose = assertNothingNoShow_ "assertNothingNoShowVerbose"
  
  -- | Fail if the given @Maybe a@ value is a 'Just'.
  -- Use this function if @a@ is not an instance of 'Show'.
  assertNothingNoShow :: HasCallStack => Maybe a -> IO ()
  assertNothingNoShow = assertNothingNoShow_ "assertNothingNoShow" ""
  
  --
  -- Sub assertions
  --
  
  -- | Use 'subAssert' if you want location information for the call site but the function
  --   being called does not carry a 'HasCallStack' constraint.
  subAssert :: (HasCallStack, MonadBaseControl IO m) => m a -> m a
  subAssert = subAssertHTF Nothing
  
  gsubAssert :: (HasCallStack, AssertM m) => m a -> m a
  gsubAssert = genericSubAssert Nothing
  
  subAssertVerbose :: (HasCallStack, MonadBaseControl IO m) => String -> m a -> m a
  subAssertVerbose msg = subAssertHTF (Just msg)
  
  gsubAssertVerbose :: (HasCallStack, AssertM m) => String -> m a -> m a
  gsubAssertVerbose msg = genericSubAssert (Just msg)
  
  testEqualityFailedMessage1 :: IO ()
  testEqualityFailedMessage1 =
      let msg = T.unpack $ renderColorString (equalityFailedMessage [1,2,3] [1,2,3,4]) False
      in HU.assertEqual "error" msg exp
      where
        exp = "\n* expected: [1, 2, 3]\n* but got:  [1, 2, 3, 4]\n* " ++
              "diff:     \nC <...[1, 2, 3...>C \nS , 4\nC ]<......>C "
  
  testEqualityFailedMessage2 :: IO ()
  testEqualityFailedMessage2 =
      let msg = T.unpack $ renderColorString (equalityFailedMessage [1,2,3] [1,2,3]) False
      in HU.assertEqual "error" msg exp
      where
        exp = "\n* expected: [1,2,3]\n* but got:  [1,2,3]\n* " ++
              "diff:     \nWARNING: strings are equal but actual values differ!"
  
  hunitWrapperTests =
      [("testEqualityFailedMessage1", testEqualityFailedMessage1)
      ,("testEqualityFailedMessage2", testEqualityFailedMessage2)]
  