{-# 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 :: forall (m :: * -> *) a. (HasCallStack, AssertM m) => [Char] -> m a
gassertFailure [Char]
s =
    ColorString -> m a
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
"assertFailure" [Char]
"" [Char]
s)

-- | Specialization of 'gassertFailure' to @IO@.
assertFailure :: HasCallStack => String -> IO a
assertFailure :: forall a. HasCallStack => [Char] -> IO a
assertFailure = [Char] -> IO a
forall (m :: * -> *) a. (HasCallStack, AssertM m) => [Char] -> m a
gassertFailure

{- |
Signals that the current unit test is pending.
-}
unitTestPending :: String -> IO a
unitTestPending :: forall a. [Char] -> IO a
unitTestPending [Char]
s =
    FullTestResult -> IO a
forall (m :: * -> *) a.
MonadBaseControl IO m =>
FullTestResult -> m a
failHTF (HtfStack -> Maybe ColorString -> Maybe TestResult -> FullTestResult
FullTestResult HtfStack
emptyHtfStack (ColorString -> Maybe ColorString
forall a. a -> Maybe a
Just (ColorString -> Maybe ColorString)
-> ColorString -> Maybe ColorString
forall a b. (a -> b) -> a -> b
$ [Char] -> ColorString
noColor [Char]
s) (TestResult -> Maybe TestResult
forall a. a -> Maybe a
Just TestResult
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' :: forall a. [Char] -> IO a -> IO a
unitTestPending' [Char]
msg IO a
_ = [Char] -> IO a
forall a. [Char] -> IO a
unitTestPending [Char]
msg

mkMsg :: String -> String -> String -> ColorString
mkMsg :: [Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
s1 [Char]
s2 [Char]
s3 = [Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
s1 [Char]
s2 ([Char] -> ColorString
noColor [Char]
s3)

mkColorMsg :: String -> String -> ColorString -> ColorString
mkColorMsg :: [Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
fun [Char]
extraInfo ColorString
s =
    let pref :: [Char]
pref = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
extraInfo
               then [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
               else [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
extraInfo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") "
    in [Char] -> ColorString
noColor [Char]
pref ColorString -> ColorString -> ColorString
+++ ColorString
s

--
-- Boolean Assertions
--

assertBool_ :: (HasCallStack, AssertM m) => String -> String -> Bool -> m ()
assertBool_ :: forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Bool -> m ()
assertBool_ [Char]
name [Char]
s Bool
False = ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s [Char]
"failed")
assertBool_ [Char]
_ [Char]
_ Bool
True = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Fail if the 'Bool' value is 'False'.
assertBool :: HasCallStack => Bool -> IO ()
assertBool :: HasCallStack => Bool -> IO ()
assertBool = [Char] -> [Char] -> Bool -> IO ()
forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Bool -> m ()
assertBool_ [Char]
"assertBool" [Char]
""

assertBoolVerbose :: HasCallStack => String -> Bool -> IO ()
assertBoolVerbose :: HasCallStack => [Char] -> Bool -> IO ()
assertBoolVerbose = [Char] -> [Char] -> Bool -> IO ()
forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Bool -> m ()
assertBool_ [Char]
"assertBoolVerbose"

gassertBool :: (HasCallStack, AssertM m) => Bool -> m ()
gassertBool :: forall (m :: * -> *). (HasCallStack, AssertM m) => Bool -> m ()
gassertBool = [Char] -> [Char] -> Bool -> m ()
forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Bool -> m ()
assertBool_ [Char]
"gassertBool" [Char]
""

gassertBoolVerbose :: (HasCallStack, AssertM m) => String -> Bool -> m ()
gassertBoolVerbose :: forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> Bool -> m ()
gassertBoolVerbose = [Char] -> [Char] -> Bool -> m ()
forall (m :: * -> *).
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Bool -> m ()
assertBool_ [Char]
"gassertBoolVerbose"

--
-- Equality Assertions
--

equalityFailedMessage' :: String -> String -> ColorString
equalityFailedMessage' :: [Char] -> [Char] -> ColorString
equalityFailedMessage' [Char]
exp [Char]
act =
    let !diff :: ColorString
diff = IO ColorString -> ColorString
forall a. IO a -> a
unsafePerformIO ([Char] -> [Char] -> IO ColorString
diffWithSensibleConfig [Char]
exp [Char]
act)
        expected_ :: ColorString
expected_ = Color -> [Char] -> ColorString
colorize Color
firstDiffColor [Char]
"* expected:"
        but_got_ :: ColorString
but_got_ = Color -> [Char] -> ColorString
colorize Color
secondDiffColor [Char]
"* but got:"
        diff_ :: ColorString
diff_ = Color -> [Char] -> ColorString
colorize Color
diffColor [Char]
"* diff:"
    in (ColorString
"\n" ColorString -> ColorString -> ColorString
+++ ColorString
expected_ ColorString -> ColorString -> ColorString
+++ ColorString
" " ColorString -> ColorString -> ColorString
+++ [Char] -> ColorString
noColor ([Char] -> [Char]
withNewline ([Char] -> [Char]
trim [Char]
exp)) ColorString -> ColorString -> ColorString
+++
        ColorString
"\n" ColorString -> ColorString -> ColorString
+++ ColorString
but_got_ ColorString -> ColorString -> ColorString
+++ ColorString
"  " ColorString -> ColorString -> ColorString
+++ [Char] -> ColorString
noColor ([Char] -> [Char]
withNewline ([Char] -> [Char]
trim [Char]
act)) ColorString -> ColorString -> ColorString
+++
        ColorString
"\n" ColorString -> ColorString -> ColorString
+++ ColorString
diff_ ColorString -> ColorString -> ColorString
+++ ColorString
"     " ColorString -> ColorString -> ColorString
+++ ColorString -> ColorString
newlineBeforeDiff ColorString
diff ColorString -> ColorString -> ColorString
+++ ColorString
diff ColorString -> ColorString -> ColorString
+++
        (if ([Char]
exp [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
act)
         then ColorString
"\nWARNING: strings are equal but actual values differ!"
         else ColorString
""))
    where
      withNewline :: [Char] -> [Char]
withNewline [Char]
s =
          case [Char] -> [[Char]]
lines [Char]
s of
            [] -> [Char]
s
            [[Char]
_] -> [Char]
s
            [[Char]]
_ -> Char
'\n'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
s
      newlineBeforeDiff :: ColorString -> ColorString
newlineBeforeDiff ColorString
d =
          let f :: Bool -> a
f Bool
b = case (Char -> Bool) -> ColorString -> Bool -> Maybe Char
colorStringFind (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') ColorString
d Bool
b of
                      Just Char
_ -> a
"\n"
                      Maybe Char
Nothing -> a
""
          in [Char] -> [Char] -> ColorString
noColor' (Bool -> [Char]
forall {a}. IsString a => Bool -> a
f Bool
True) (Bool -> [Char]
forall {a}. IsString a => Bool -> a
f Bool
False)
      trim :: [Char] -> [Char]
trim [Char]
s =
          case Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
maxLen [Char]
s of
            ([Char]
_, []) -> [Char]
s
            ([Char]
prefix, [Char]
rest) ->
                [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (removed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
rest) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" trailing chars)"
      maxLen :: Int
maxLen = Int
10000

asString :: Show a => a -> Maybe String
asString :: forall a. Show a => a -> Maybe [Char]
asString a
x = [Char] -> Maybe [Char]
forall (m :: * -> *) a. (MonadFail m, Read a) => [Char] -> m a
readM (a -> [Char]
forall a. Show a => a -> [Char]
show a
x)

equalityFailedMessage :: (Show a) => a -> a -> ColorString
equalityFailedMessage :: forall a. Show a => a -> a -> ColorString
equalityFailedMessage a
exp a
act =
    [Char] -> [Char] -> ColorString
equalityFailedMessage' [Char]
expP [Char]
actP
    where
      ([Char]
expP, [Char]
actP) =
        case (a -> Maybe [Char]
forall a. Show a => a -> Maybe [Char]
asString a
exp, a -> Maybe [Char]
forall a. Show a => a -> Maybe [Char]
asString a
act) of
          (Just [Char]
expS, Just [Char]
actS)
            | [Char]
expS [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
actS -> ([Char]
expS, [Char]
actS)
          (Maybe [Char], Maybe [Char])
_ ->
            case (a -> Maybe [Char]
forall a. Show a => a -> Maybe [Char]
prettyHaskell' a
exp, a -> Maybe [Char]
forall a. Show a => a -> Maybe [Char]
prettyHaskell' a
act) of
              (Maybe [Char]
Nothing, Maybe [Char]
_) -> (a -> [Char]
forall a. Show a => a -> [Char]
show a
exp, a -> [Char]
forall a. Show a => a -> [Char]
show a
act)
              (Maybe [Char]
_, Maybe [Char]
Nothing) -> (a -> [Char]
forall a. Show a => a -> [Char]
show a
exp, a -> [Char]
forall a. Show a => a -> [Char]
show a
act)
              (Just [Char]
expP, Just [Char]
actP)
                  | [Char]
expP [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
actP ->
                      (a -> [Char]
forall a. Show a => a -> [Char]
show a
exp, a -> [Char]
forall a. Show a => a -> [Char]
show a
act)
                  | Bool
otherwise -> ([Char]
expP, [Char]
actP)

notEqualityFailedMessage :: Show a => a -> String
notEqualityFailedMessage :: forall a. Show a => a -> [Char]
notEqualityFailedMessage a
exp =
    [Char] -> [Char]
notEqualityFailedMessage' (a -> [Char]
forall a. Show a => a -> [Char]
prettyHaskell a
exp)

notEqualityFailedMessage' :: String -> String
notEqualityFailedMessage' :: [Char] -> [Char]
notEqualityFailedMessage' [Char]
exp =
    ([Char]
": Objects are equal\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
exp)

failedAt :: HasCallStack => String
failedAt :: HasCallStack => [Char]
failedAt =
  case Maybe Location
HasCallStack => Maybe Location
failureLocation of
    Maybe Location
Nothing -> [Char]
"failed"
    Just Location
loc -> [Char]
"failed at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Location -> [Char]
showLoc Location
loc

assertEqual_ :: (Eq a, Show a, AssertM m, HasCallStack)
                 => String -> String -> a -> a -> m ()
assertEqual_ :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqual_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
actual
       then do let x :: ColorString
x = a -> a -> ColorString
forall a. Show a => a -> a -> ColorString
equalityFailedMessage a
expected a
actual
               ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
name [Char]
s (ColorString -> ColorString) -> ColorString -> ColorString
forall a b. (a -> b) -> a -> b
$
                                      [Char] -> ColorString
noColor [Char]
HasCallStack => [Char]
failedAt ColorString -> ColorString -> ColorString
+++ ColorString
x)
       else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertEqualVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqual_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertEqual = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqual_ [Char]
"gassertEqual" [Char]
""

-- | 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 :: forall a. (Eq a, Show a, HasCallStack) => [Char] -> a -> a -> IO ()
assertEqualVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqual_ [Char]
"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 :: forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqual_ [Char]
"assertEqual" [Char]
""

assertNotEqual_ :: (Eq a, Show a, AssertM m, HasCallStack)
                => String -> String -> a -> a -> m ()
assertNotEqual_ :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqual_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual
       then do let x :: [Char]
x = a -> [Char]
forall a. Show a => a -> [Char]
notEqualityFailedMessage a
expected
               ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s ([Char] -> ColorString) -> [Char] -> ColorString
forall a b. (a -> b) -> a -> b
$ [Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x)
       else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertNotEqualVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqual_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertNotEqual = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqual_ [Char]
"gassertNotEqual" [Char]
""

-- | 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 :: forall a. (Eq a, Show a, HasCallStack) => [Char] -> a -> a -> IO ()
assertNotEqualVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqual_ [Char]
"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 :: forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertNotEqual = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqual_ [Char]
"assertNotEqual" [Char]
""

assertEqualPretty_ :: (Eq a, Pretty a, AssertM m, HasCallStack)
                   => String -> String -> a -> a -> m ()
assertEqualPretty_ :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualPretty_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
actual
       then do let x :: ColorString
x = [Char] -> [Char] -> ColorString
equalityFailedMessage' (a -> [Char]
forall a. Pretty a => a -> [Char]
showPretty a
expected) (a -> [Char]
forall a. Pretty a => a -> [Char]
showPretty a
actual)
               ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
name [Char]
s
                                      ([Char] -> ColorString
noColor [Char]
HasCallStack => [Char]
failedAt ColorString -> ColorString -> ColorString
+++ ColorString
x))
       else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertEqualPrettyVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualPretty_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertEqualPretty = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualPretty_ [Char]
"gassertEqualPretty" [Char]
""

-- | 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 :: forall a.
(Eq a, Pretty a, HasCallStack) =>
[Char] -> a -> a -> IO ()
assertEqualPrettyVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualPretty_ [Char]
"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 :: forall a. (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
assertEqualPretty = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualPretty_ [Char]
"assertEqualPretty" [Char]
""

assertNotEqualPretty_ :: (Eq a, Pretty a, AssertM m, HasCallStack)
                       => String -> String -> a -> a -> m ()
assertNotEqualPretty_ :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualPretty_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual
       then do let x :: [Char]
x = [Char] -> [Char]
notEqualityFailedMessage' (a -> [Char]
forall a. Pretty a => a -> [Char]
showPretty a
expected)
               ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s ([Char] -> ColorString) -> [Char] -> ColorString
forall a b. (a -> b) -> a -> b
$ [Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x)
       else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertNotEqualPrettyVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualPretty_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertNotEqualPretty = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualPretty_ [Char]
"gassertNotEqualPretty" [Char]
""

-- | 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 :: forall a.
(Eq a, Pretty a, HasCallStack) =>
[Char] -> a -> a -> IO ()
assertNotEqualPrettyVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualPretty_ [Char]
"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 :: forall a. (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
assertNotEqualPretty = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, Pretty a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualPretty_ [Char]
"assertNotEqualPretty" [Char]
""

assertEqualNoShow_ :: (Eq a, AssertM m, HasCallStack)
                    => String -> String -> a -> a -> m ()
assertEqualNoShow_ :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualNoShow_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
actual
    then ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s [Char]
HasCallStack => [Char]
failedAt)
    else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertEqualNoShowVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualNoShow_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertEqualNoShow = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualNoShow_ [Char]
"gassertEqualNoShow" [Char]
""

-- | 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 :: forall a. (Eq a, HasCallStack) => [Char] -> a -> a -> IO ()
assertEqualNoShowVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualNoShow_ [Char]
"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 :: forall a. (Eq a, HasCallStack) => a -> a -> IO ()
assertEqualNoShow = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertEqualNoShow_ [Char]
"assertEqualNoShow" [Char]
""

assertNotEqualNoShow_ :: (Eq a, AssertM m, HasCallStack)
                      => String -> String -> a -> a -> m ()
assertNotEqualNoShow_ :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualNoShow_ [Char]
name [Char]
s a
expected a
actual =
    if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual
       then ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s [Char]
HasCallStack => [Char]
failedAt)
       else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> a -> a -> m ()
gassertNotEqualNoShowVerbose = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualNoShow_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
a -> a -> m ()
gassertNotEqualNoShow = [Char] -> [Char] -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualNoShow_ [Char]
"gassertNotEqualNoShow" [Char]
""

-- | 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 :: forall a. (Eq a, HasCallStack) => [Char] -> a -> a -> IO ()
assertNotEqualNoShowVerbose = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualNoShow_ [Char]
"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 :: forall a. (Eq a, HasCallStack) => a -> a -> IO ()
assertNotEqualNoShow = [Char] -> [Char] -> a -> a -> IO ()
forall a (m :: * -> *).
(Eq a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> a -> m ()
assertNotEqualNoShow_ [Char]
"assertNotEqualNoShow" [Char]
""

--
-- Assertions on Lists
--

assertListsEqualAsSets_ :: (Eq a, Show a, AssertM m, HasCallStack)
                   => String -> String -> [a] -> [a] -> m ()
assertListsEqualAsSets_ :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> [a] -> m ()
assertListsEqualAsSets_ [Char]
name [Char]
s [a]
expected [a]
actual =
    let ne :: Int
ne = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
expected
        na :: Int
na = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
actual
        in case () of
            ()
_| Int
ne Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
na ->
                 do let x :: ColorString
x = [a] -> [a] -> ColorString
forall a. Show a => a -> a -> ColorString
equalityFailedMessage [a]
expected [a]
actual
                    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
name [Char]
s
                                           ([Char] -> ColorString
noColor
                                             ([Char]
HasCallStack => [Char]
failedAt
                                               [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n expected length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ne
                                               [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n actual length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
na) ColorString -> ColorString -> ColorString
+++
                                             (if ColorString -> Int
maxLength ColorString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5000
                                               then ColorString
x else ColorString
emptyColorString)))
             | Bool -> Bool
not ([a] -> [a] -> Bool
forall {a}. Eq a => [a] -> [a] -> Bool
unorderedEq [a]
expected [a]
actual) ->
                 do let x :: ColorString
x = [a] -> [a] -> ColorString
forall a. Show a => a -> a -> ColorString
equalityFailedMessage [a]
expected [a]
actual
                    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> ColorString -> ColorString
mkColorMsg [Char]
"assertSetEqual" [Char]
s
                                           ([Char] -> ColorString
noColor [Char]
HasCallStack => [Char]
failedAt ColorString -> ColorString -> ColorString
+++ ColorString
x))
             | Bool
otherwise -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where unorderedEq :: [a] -> [a] -> Bool
unorderedEq [a]
l1 [a]
l2 =
              [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
l1 [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
l2) Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
l2 [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [a] -> [a] -> m ()
gassertListsEqualAsSetsVerbose = [Char] -> [Char] -> [a] -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> [a] -> m ()
assertListsEqualAsSets_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[a] -> [a] -> m ()
gassertListsEqualAsSets= [Char] -> [Char] -> [a] -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> [a] -> m ()
assertListsEqualAsSets_ [Char]
"gassertListsEqualAsSets" [Char]
""

-- | 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 :: forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> [a] -> [a] -> IO ()
assertListsEqualAsSetsVerbose = [Char] -> [Char] -> [a] -> [a] -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> [a] -> m ()
assertListsEqualAsSets_ [Char]
"assertListsEqualAsSetsVerbose"

-- | Fail if the two given lists are not equal when considered as sets.
assertListsEqualAsSets :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> IO ()
assertListsEqualAsSets :: forall a. (Eq a, Show a, HasCallStack) => [a] -> [a] -> IO ()
assertListsEqualAsSets = [Char] -> [Char] -> [a] -> [a] -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> [a] -> m ()
assertListsEqualAsSets_ [Char]
"assertListsEqualAsSets" [Char]
""

assertNotEmpty_ :: (AssertM m, HasCallStack) => String -> String -> [a] -> m ()
assertNotEmpty_ :: forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertNotEmpty_ [Char]
name [Char]
s [] =
    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s [Char]
HasCallStack => [Char]
failedAt)
assertNotEmpty_ [Char]
_ [Char]
_ (a
_:[a]
_) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [a] -> m ()
gassertNotEmptyVerbose = [Char] -> [Char] -> [a] -> m ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertNotEmpty_ [Char]
"gassertNotEmptyVerbose"

-- | Fail in some 'AssertM' monad if the given list is empty.
gassertNotEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
gassertNotEmpty :: forall (m :: * -> *) a. (HasCallStack, AssertM m) => [a] -> m ()
gassertNotEmpty = [Char] -> [Char] -> [a] -> m ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertNotEmpty_ [Char]
"gassertNotEmpty" [Char]
""

-- | Fail if the given list is empty, supplying an
-- additional error message.
assertNotEmptyVerbose ::  HasCallStack => String -> [a] -> IO ()
assertNotEmptyVerbose :: forall a. HasCallStack => [Char] -> [a] -> IO ()
assertNotEmptyVerbose = [Char] -> [Char] -> [a] -> IO ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertNotEmpty_ [Char]
"assertNotEmptyVerbose"

-- | Fail if the given list is empty.
assertNotEmpty ::  HasCallStack => [a] -> IO ()
assertNotEmpty :: forall a. HasCallStack => [a] -> IO ()
assertNotEmpty = [Char] -> [Char] -> [a] -> IO ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertNotEmpty_ [Char]
"assertNotEmpty" [Char]
""

assertEmpty_ :: (AssertM m, HasCallStack) => String -> String -> [a] -> m ()
assertEmpty_ :: forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertEmpty_ [Char]
name [Char]
s (a
_:[a]
_) =
    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s [Char]
HasCallStack => [Char]
failedAt)
assertEmpty_ [Char]
_ [Char]
_ [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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 :: forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [a] -> m ()
gassertEmptyVerbose = [Char] -> [Char] -> [a] -> m ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertEmpty_ [Char]
"gassertEmptyVerbose"

-- | Fail in some 'AssertM' monad if the given list is not empty.
gassertEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
gassertEmpty :: forall (m :: * -> *) a. (HasCallStack, AssertM m) => [a] -> m ()
gassertEmpty = [Char] -> [Char] -> [a] -> m ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertEmpty_ [Char]
"gassertEmpty" [Char]
""

-- | Fail if the given list is not empty, supplying an
-- additional error message.
assertEmptyVerbose ::  HasCallStack => String -> [a] -> IO ()
assertEmptyVerbose :: forall a. HasCallStack => [Char] -> [a] -> IO ()
assertEmptyVerbose = [Char] -> [Char] -> [a] -> IO ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertEmpty_ [Char]
"assertEmptyVerbose"

-- | Fail if the given list is not empty.
assertEmpty ::  HasCallStack => [a] -> IO ()
assertEmpty :: forall a. HasCallStack => [a] -> IO ()
assertEmpty = [Char] -> [Char] -> [a] -> IO ()
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
[Char] -> [Char] -> [a] -> m ()
assertEmpty_ [Char]
"assertEmpty" [Char]
""

assertElem_ :: (Eq a, Show a, AssertM m, HasCallStack) => String -> String -> a -> [a] -> m ()
assertElem_ :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> [a] -> m ()
assertElem_ [Char]
name [Char]
s a
x [a]
l =
    if a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l
    then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                                ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                  [Char]
"\n element: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                  [Char]
"\n list:   " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => a -> [Char]
show [a]
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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> a -> [a] -> m ()
gassertElemVerbose = [Char] -> [Char] -> a -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> [a] -> m ()
assertElem_ [Char]
"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 :: forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
a -> [a] -> m ()
gassertElem = [Char] -> [Char] -> a -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> [a] -> m ()
assertElem_ [Char]
"gassertElem" [Char]
""

-- | 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 :: forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> [a] -> IO ()
assertElemVerbose = [Char] -> [Char] -> a -> [a] -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> [a] -> m ()
assertElem_ [Char]
"assertElemVerbose"

-- | Fail if the element given is not contained in the list.
assertElem :: (Eq a, Show a, HasCallStack) => a -> [a] -> IO ()
assertElem :: forall a. (Eq a, Show a, HasCallStack) => a -> [a] -> IO ()
assertElem = [Char] -> [Char] -> a -> [a] -> IO ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> a -> [a] -> m ()
assertElem_ [Char]
"assertElem" [Char]
""

--
-- Assertions for Exceptions
--

assertThrowsIO_ :: (HasCallStack, Exception e)
                 => String -> String -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ :: forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ [Char]
name [Char]
s IO a
x e -> Bool
f =
    [Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> [Char] -> m a -> (e -> Bool) -> m ()
assertThrowsM_ [Char]
name [Char]
s IO a
x e -> Bool
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 :: forall e a.
(HasCallStack, Exception e) =>
[Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIOVerbose = [Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ [Char]
"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 :: forall e a.
(HasCallStack, Exception e) =>
IO a -> (e -> Bool) -> IO ()
assertThrowsIO = [Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ [Char]
"assertThrowsIO" [Char]
""

assertThrowsSomeIO_ :: HasCallStack => String -> String -> IO a -> IO ()
assertThrowsSomeIO_ :: forall a. HasCallStack => [Char] -> [Char] -> IO a -> IO ()
assertThrowsSomeIO_ [Char]
name [Char]
s IO a
x = [Char] -> [Char] -> IO a -> (SomeException -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ [Char]
name [Char]
s IO a
x (\ (SomeException
_e::SomeException) -> Bool
True)

-- | Fail if executing the 'IO' action does not throw any exception,
-- supplying an additional error message.
assertThrowsSomeIOVerbose ::  HasCallStack => String -> IO a -> IO ()
assertThrowsSomeIOVerbose :: forall a. HasCallStack => [Char] -> IO a -> IO ()
assertThrowsSomeIOVerbose = [Char] -> [Char] -> IO a -> IO ()
forall a. HasCallStack => [Char] -> [Char] -> IO a -> IO ()
assertThrowsSomeIO_ [Char]
"assertThrowsSomeIOVerbose"

-- | Fail if executing the 'IO' action does not throw any exception.
assertThrowsSomeIO :: HasCallStack => IO a -> IO ()
assertThrowsSomeIO :: forall a. HasCallStack => IO a -> IO ()
assertThrowsSomeIO = [Char] -> [Char] -> IO a -> IO ()
forall a. HasCallStack => [Char] -> [Char] -> IO a -> IO ()
assertThrowsSomeIO_ [Char]
"assertThrowsSomeIO" [Char]
""

assertThrowsM_ :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack)
                => String -> String -> m a -> (e -> Bool) -> m ()
assertThrowsM_ :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> [Char] -> m a -> (e -> Bool) -> m ()
assertThrowsM_ [Char]
name [Char]
s m a
x e -> Bool
f =
    do Either e a
res <- m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
ExL.try m a
x
       case Either e a
res of
         Right a
_ -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                    ColorString -> IO ()
forall a. HasCallStack => ColorString -> IO a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                             [Char]
": no exception was thrown"))
         Left e
e -> if e -> Bool
f e
e then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   else IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                        ColorString -> IO ()
forall a. HasCallStack => ColorString -> IO a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                                               ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                                 [Char]
": wrong exception was thrown: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                                 e -> [Char]
forall a. Show a => a -> [Char]
show e
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 :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> m a -> (e -> Bool) -> m ()
assertThrowsMVerbose = [Char] -> [Char] -> m a -> (e -> Bool) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> [Char] -> m a -> (e -> Bool) -> m ()
assertThrowsM_ [Char]
"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 :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
m a -> (e -> Bool) -> m ()
assertThrowsM = [Char] -> [Char] -> m a -> (e -> Bool) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> [Char] -> m a -> (e -> Bool) -> m ()
assertThrowsM_ [Char]
"assertThrowsM" [Char]
""

assertThrowsSomeM_ :: (MonadBaseControl IO m, MonadIO m, HasCallStack)
                    => String -> String -> m a -> m ()
assertThrowsSomeM_ :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m, HasCallStack) =>
[Char] -> [Char] -> m a -> m ()
assertThrowsSomeM_ [Char]
name [Char]
s m a
x = [Char] -> [Char] -> m a -> (SomeException -> Bool) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) =>
[Char] -> [Char] -> m a -> (e -> Bool) -> m ()
assertThrowsM_ [Char]
name [Char]
s m a
x (\ (SomeException
_e::SomeException) -> Bool
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 :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m, HasCallStack) =>
[Char] -> m a -> m ()
assertThrowsSomeMVerbose = [Char] -> [Char] -> m a -> m ()
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m, HasCallStack) =>
[Char] -> [Char] -> m a -> m ()
assertThrowsSomeM_ [Char]
"assertThrowsSomeMVerbose"

-- | Fail if executing the @m@ action does not throw any exception.
assertThrowsSomeM :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => m a -> m ()
assertThrowsSomeM :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m, HasCallStack) =>
m a -> m ()
assertThrowsSomeM = [Char] -> [Char] -> m a -> m ()
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m, HasCallStack) =>
[Char] -> [Char] -> m a -> m ()
assertThrowsSomeM_ [Char]
"assertThrowsSomeM" [Char]
""

assertThrows_ :: (HasCallStack, Exception e)
               => String -> String -> a -> (e -> Bool) -> IO ()
assertThrows_ :: forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> a -> (e -> Bool) -> IO ()
assertThrows_ [Char]
name [Char]
s a
x e -> Bool
f = [Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ [Char]
name [Char]
s (a -> IO a
forall a. a -> IO a
evaluate a
x) e -> Bool
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 :: forall e a.
(HasCallStack, Exception e) =>
[Char] -> a -> (e -> Bool) -> IO ()
assertThrowsVerbose = [Char] -> [Char] -> a -> (e -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> a -> (e -> Bool) -> IO ()
assertThrows_ [Char]
"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 :: forall e a.
(HasCallStack, Exception e) =>
a -> (e -> Bool) -> IO ()
assertThrows = [Char] -> [Char] -> a -> (e -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> a -> (e -> Bool) -> IO ()
assertThrows_ [Char]
"assertThrows" [Char]
""

assertThrowsSome_ :: HasCallStack => String -> String -> a -> IO ()
assertThrowsSome_ :: forall a. HasCallStack => [Char] -> [Char] -> a -> IO ()
assertThrowsSome_ [Char]
name [Char]
s a
x =
    [Char] -> [Char] -> a -> (SomeException -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
[Char] -> [Char] -> a -> (e -> Bool) -> IO ()
assertThrows_ [Char]
name [Char]
s a
x (\ (SomeException
_e::SomeException) -> Bool
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 :: forall a. HasCallStack => [Char] -> a -> IO ()
assertThrowsSomeVerbose = [Char] -> [Char] -> a -> IO ()
forall a. HasCallStack => [Char] -> [Char] -> a -> IO ()
assertThrowsSome_ [Char]
"assertThrowsSomeVerbose"

-- | Fail if evaluating the expression of type @a@ does not
-- throw any exception.
assertThrowsSome ::  HasCallStack => a -> IO ()
assertThrowsSome :: forall a. HasCallStack => a -> IO ()
assertThrowsSome = [Char] -> [Char] -> a -> IO ()
forall a. HasCallStack => [Char] -> [Char] -> a -> IO ()
assertThrowsSome_ [Char]
"assertThrowsSome" [Char]
""

--
-- Assertions on Either
--

assertLeft_ :: forall a b m . (AssertM m, Show b, HasCallStack)
             => String -> String -> Either a b -> m a
assertLeft_ :: forall a b (m :: * -> *).
(AssertM m, Show b, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m a
assertLeft_ [Char]
_ [Char]
_ (Left a
x) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
assertLeft_ [Char]
name [Char]
s (Right b
x) =
    ColorString -> m a
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": expected a Left value, given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             Either b b -> [Char]
forall a. Show a => a -> [Char]
show (b -> Either b b
forall a b. b -> Either a b
Right b
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 :: forall b (m :: * -> *) a.
(Show b, AssertM m, HasCallStack) =>
[Char] -> Either a b -> m a
gassertLeftVerbose = [Char] -> [Char] -> Either a b -> m a
forall a b (m :: * -> *).
(AssertM m, Show b, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m a
assertLeft_ [Char]
"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 :: forall b (m :: * -> *) a.
(Show b, AssertM m, HasCallStack) =>
Either a b -> m a
gassertLeft = [Char] -> [Char] -> Either a b -> m a
forall a b (m :: * -> *).
(AssertM m, Show b, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m a
assertLeft_ [Char]
"gassertLeft" [Char]
""

-- | 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 :: forall b a. (Show b, HasCallStack) => [Char] -> Either a b -> IO a
assertLeftVerbose = [Char] -> [Char] -> Either a b -> IO a
forall a b (m :: * -> *).
(AssertM m, Show b, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m a
assertLeft_ [Char]
"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 :: forall b a. (HasCallStack, Show b) => Either a b -> IO a
assertLeft = [Char] -> [Char] -> Either a b -> IO a
forall a b (m :: * -> *).
(AssertM m, Show b, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m a
assertLeft_ [Char]
"assertLeft" [Char]
""

assertLeftNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Either a b -> m a
assertLeftNoShow_ :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m a
assertLeftNoShow_ [Char]
_ [Char]
_ (Left a
x) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
assertLeftNoShow_ [Char]
name [Char]
s (Right b
_) =
    ColorString -> m a
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": 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 :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> Either a b -> m a
gassertLeftNoShowVerbose = [Char] -> [Char] -> Either a b -> m a
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m a
assertLeftNoShow_ [Char]
"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 :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
Either a b -> m a
gassertLeftNoShow = [Char] -> [Char] -> Either a b -> m a
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m a
assertLeftNoShow_ [Char]
"gassertLeftNoShow" [Char]
""

-- | 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 :: forall a b. HasCallStack => [Char] -> Either a b -> IO a
assertLeftNoShowVerbose = [Char] -> [Char] -> Either a b -> IO a
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m a
assertLeftNoShow_ [Char]
"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 :: forall a b. HasCallStack => Either a b -> IO a
assertLeftNoShow = [Char] -> [Char] -> Either a b -> IO a
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m a
assertLeftNoShow_ [Char]
"assertLeftNoShow" [Char]
""

assertRight_ :: forall a b m . (AssertM m, Show a, HasCallStack)
             => String -> String -> Either a b -> m b
assertRight_ :: forall a b (m :: * -> *).
(AssertM m, Show a, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m b
assertRight_ [Char]
_ [Char]
_ (Right b
x) = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
assertRight_ [Char]
name [Char]
s (Left a
x) =
    ColorString -> m b
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": expected a Right value, given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             Either a a -> [Char]
forall a. Show a => a -> [Char]
show (a -> Either a a
forall a b. a -> Either a b
Left a
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 :: forall a (m :: * -> *) b.
(Show a, AssertM m, HasCallStack) =>
[Char] -> Either a b -> m b
gassertRightVerbose = [Char] -> [Char] -> Either a b -> m b
forall a b (m :: * -> *).
(AssertM m, Show a, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m b
assertRight_ [Char]
"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 :: forall a (m :: * -> *) b.
(Show a, AssertM m, HasCallStack) =>
Either a b -> m b
gassertRight = [Char] -> [Char] -> Either a b -> m b
forall a b (m :: * -> *).
(AssertM m, Show a, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m b
assertRight_ [Char]
"gassertRight" [Char]
""

-- | 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 :: forall a b. (Show a, HasCallStack) => [Char] -> Either a b -> IO b
assertRightVerbose = [Char] -> [Char] -> Either a b -> IO b
forall a b (m :: * -> *).
(AssertM m, Show a, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m b
assertRight_ [Char]
"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 :: forall a b. (HasCallStack, Show a) => Either a b -> IO b
assertRight = [Char] -> [Char] -> Either a b -> IO b
forall a b (m :: * -> *).
(AssertM m, Show a, HasCallStack) =>
[Char] -> [Char] -> Either a b -> m b
assertRight_ [Char]
"assertRight" [Char]
""

assertRightNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Either a b -> m b
assertRightNoShow_ :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m b
assertRightNoShow_ [Char]
_ [Char]
_ (Right b
x) = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
assertRightNoShow_ [Char]
name [Char]
s (Left a
_) =
    ColorString -> m b
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": 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 :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> Either a b -> m b
gassertRightNoShowVerbose = [Char] -> [Char] -> Either a b -> m b
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m b
assertRightNoShow_ [Char]
"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 :: forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
Either a b -> m b
gassertRightNoShow = [Char] -> [Char] -> Either a b -> m b
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m b
assertRightNoShow_ [Char]
"gassertRightNoShow" [Char]
""

-- | 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 :: forall a b. HasCallStack => [Char] -> Either a b -> IO b
assertRightNoShowVerbose = [Char] -> [Char] -> Either a b -> IO b
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m b
assertRightNoShow_ [Char]
"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 :: forall a b. HasCallStack => Either a b -> IO b
assertRightNoShow = [Char] -> [Char] -> Either a b -> IO b
forall (m :: * -> *) a b.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Either a b -> m b
assertRightNoShow_ [Char]
"assertRightNoShow" [Char]
""

--
-- Assertions on Maybe
--

assertJust_ :: (HasCallStack, AssertM m) => String -> String -> Maybe a -> m a
assertJust_ :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m a
assertJust_ [Char]
_ [Char]
_ (Just a
x) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
assertJust_ [Char]
name [Char]
s Maybe a
Nothing =
    ColorString -> m a
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": 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 :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> Maybe a -> m a
gassertJustVerbose = [Char] -> [Char] -> Maybe a -> m a
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m a
assertJust_ [Char]
"gassertJustVerbose"

-- | Fail in some 'AssertM' monad if the given value is a Nothing.
gassertJust :: (HasCallStack, AssertM m) => Maybe a -> m a
gassertJust :: forall (m :: * -> *) a. (HasCallStack, AssertM m) => Maybe a -> m a
gassertJust = [Char] -> [Char] -> Maybe a -> m a
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m a
assertJust_ [Char]
"gassertJust" [Char]
""

-- | Fail if the given value is a Nothing, supplying an additional
-- error message.
assertJustVerbose :: HasCallStack => String -> Maybe a -> IO a
assertJustVerbose :: forall a. HasCallStack => [Char] -> Maybe a -> IO a
assertJustVerbose = [Char] -> [Char] -> Maybe a -> IO a
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m a
assertJust_ [Char]
"assertJustVerbose"

-- | Fail if the given value is a Nothing.
assertJust :: HasCallStack => Maybe a -> IO a
assertJust :: forall a. HasCallStack => Maybe a -> IO a
assertJust = [Char] -> [Char] -> Maybe a -> IO a
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m a
assertJust_ [Char]
"assertJust" [Char]
""

assertNothing_ :: (Show a, AssertM m, HasCallStack)
                => String -> String -> Maybe a -> m ()
assertNothing_ :: forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothing_ [Char]
_ [Char]
_ Maybe a
Nothing = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertNothing_ [Char]
name [Char]
s Maybe a
jx =
    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": expected Nothing, given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Char]
forall a. Show a => a -> [Char]
show Maybe a
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 :: forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> Maybe a -> m ()
gassertNothingVerbose = [Char] -> [Char] -> Maybe a -> m ()
forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothing_ [Char]
"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 :: forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
Maybe a -> m ()
gassertNothing = [Char] -> [Char] -> Maybe a -> m ()
forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothing_ [Char]
"gassertNothing" [Char]
""

-- | 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 :: forall a. (Show a, HasCallStack) => [Char] -> Maybe a -> IO ()
assertNothingVerbose = [Char] -> [Char] -> Maybe a -> IO ()
forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothing_ [Char]
"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 :: forall a. (HasCallStack, Show a) => Maybe a -> IO ()
assertNothing = [Char] -> [Char] -> Maybe a -> IO ()
forall a (m :: * -> *).
(Show a, AssertM m, HasCallStack) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothing_ [Char]
"assertNothing" [Char]
""

assertNothingNoShow_ :: (HasCallStack, AssertM m) => String -> String -> Maybe a -> m ()
assertNothingNoShow_ :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothingNoShow_ [Char]
_ [Char]
_ Maybe a
Nothing = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertNothingNoShow_ [Char]
name [Char]
s Maybe a
_ =
    ColorString -> m ()
forall a. HasCallStack => ColorString -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure ([Char] -> [Char] -> [Char] -> ColorString
mkMsg [Char]
name [Char]
s
                           ([Char]
HasCallStack => [Char]
failedAt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
": 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 :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> Maybe a -> m ()
gassertNothingNoShowVerbose = [Char] -> [Char] -> Maybe a -> m ()
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothingNoShow_ [Char]
"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 :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
Maybe a -> m ()
gassertNothingNoShow = [Char] -> [Char] -> Maybe a -> m ()
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothingNoShow_ [Char]
"gassertNothingNoShow" [Char]
""

-- | 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 :: forall a. HasCallStack => [Char] -> Maybe a -> IO ()
assertNothingNoShowVerbose = [Char] -> [Char] -> Maybe a -> IO ()
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothingNoShow_ [Char]
"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 :: forall a. HasCallStack => Maybe a -> IO ()
assertNothingNoShow = [Char] -> [Char] -> Maybe a -> IO ()
forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> [Char] -> Maybe a -> m ()
assertNothingNoShow_ [Char]
"assertNothingNoShow" [Char]
""

--
-- 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 :: forall (m :: * -> *) a.
(HasCallStack, MonadBaseControl IO m) =>
m a -> m a
subAssert = Maybe [Char] -> m a -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadBaseControl IO m) =>
Maybe [Char] -> m a -> m a
subAssertHTF Maybe [Char]
forall a. Maybe a
Nothing

gsubAssert :: (HasCallStack, AssertM m) => m a -> m a
gsubAssert :: forall (m :: * -> *) a. (HasCallStack, AssertM m) => m a -> m a
gsubAssert = Maybe [Char] -> m a -> m a
forall a. HasCallStack => Maybe [Char] -> m a -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
Maybe [Char] -> m a -> m a
genericSubAssert Maybe [Char]
forall a. Maybe a
Nothing

subAssertVerbose :: (HasCallStack, MonadBaseControl IO m) => String -> m a -> m a
subAssertVerbose :: forall (m :: * -> *) a.
(HasCallStack, MonadBaseControl IO m) =>
[Char] -> m a -> m a
subAssertVerbose [Char]
msg = Maybe [Char] -> m a -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadBaseControl IO m) =>
Maybe [Char] -> m a -> m a
subAssertHTF ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
msg)

gsubAssertVerbose :: (HasCallStack, AssertM m) => String -> m a -> m a
gsubAssertVerbose :: forall (m :: * -> *) a.
(HasCallStack, AssertM m) =>
[Char] -> m a -> m a
gsubAssertVerbose [Char]
msg = Maybe [Char] -> m a -> m a
forall a. HasCallStack => Maybe [Char] -> m a -> m a
forall (m :: * -> *) a.
(AssertM m, HasCallStack) =>
Maybe [Char] -> m a -> m a
genericSubAssert ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
msg)

testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 =
    let msg :: [Char]
msg = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ColorString -> Bool -> Text
renderColorString ([Integer] -> [Integer] -> ColorString
forall a. Show a => a -> a -> ColorString
equalityFailedMessage [Integer
1,Integer
2,Integer
3] [Integer
1,Integer
2,Integer
3,Integer
4]) Bool
False
    in [Char] -> [Char] -> [Char] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => [Char] -> a -> a -> IO ()
HU.assertEqual [Char]
"error" [Char]
msg [Char]
exp
    where
      exp :: [Char]
exp = [Char]
"\n* expected: [1, 2, 3]\n* but got:  [1, 2, 3, 4]\n* " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"diff:     \nC <...[1, 2, 3...>C \nS , 4\nC ]<......>C "

testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 =
    let msg :: [Char]
msg = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ColorString -> Bool -> Text
renderColorString ([Integer] -> [Integer] -> ColorString
forall a. Show a => a -> a -> ColorString
equalityFailedMessage [Integer
1,Integer
2,Integer
3] [Integer
1,Integer
2,Integer
3]) Bool
False
    in [Char] -> [Char] -> [Char] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => [Char] -> a -> a -> IO ()
HU.assertEqual [Char]
"error" [Char]
msg [Char]
exp
    where
      exp :: [Char]
exp = [Char]
"\n* expected: [1,2,3]\n* but got:  [1,2,3]\n* " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"diff:     \nWARNING: strings are equal but actual values differ!"

hunitWrapperTests :: [([Char], IO ())]
hunitWrapperTests =
    [([Char]
"testEqualityFailedMessage1", IO ()
testEqualityFailedMessage1)
    ,([Char]
"testEqualityFailedMessage2", IO ()
testEqualityFailedMessage2)]