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

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

{- |
Signals that the current unit test is pending.
-}
unitTestPending :: String -> IO a
unitTestPending :: String -> IO a
unitTestPending String
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
$ String -> ColorString
noColor String
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' :: String -> IO a -> IO a
unitTestPending' String
msg IO a
_ = String -> IO a
forall a. String -> IO a
unitTestPending String
msg

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

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

--
-- Boolean Assertions
--

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

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

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

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

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

--
-- Equality Assertions
--

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

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

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

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

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

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

assertEqual_ :: (Eq a, Show a, AssertM m, HasCallStack)
                 => String -> String -> a -> a -> m ()
assertEqual_ :: String -> String -> a -> a -> m ()
assertEqual_ String
name String
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 (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure (String -> String -> ColorString -> ColorString
mkColorMsg String
name String
s (ColorString -> ColorString) -> ColorString -> ColorString
forall a b. (a -> b) -> a -> b
$
                                      String -> ColorString
noColor String
HasCallStack => String
failedAt ColorString -> ColorString -> ColorString
+++ ColorString
x)
       else () -> m ()
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 :: String -> a -> a -> m ()
gassertEqualVerbose = String -> String -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
String -> String -> a -> a -> m ()
assertEqual_ String
"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 :: a -> a -> m ()
gassertEqual = String -> String -> a -> a -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
String -> String -> a -> a -> m ()
assertEqual_ String
"gassertEqual" String
""

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

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

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

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

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

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

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

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

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

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

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

--
-- Assertions on Lists
--

assertListsEqualAsSets_ :: (Eq a, Show a, AssertM m, HasCallStack)
                   => String -> String -> [a] -> [a] -> m ()
assertListsEqualAsSets_ :: String -> String -> [a] -> [a] -> m ()
assertListsEqualAsSets_ String
name String
s [a]
expected [a]
actual =
    let ne :: Int
ne = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
expected
        na :: Int
na = [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 (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure (String -> String -> ColorString -> ColorString
mkColorMsg String
name String
s
                                           (String -> ColorString
noColor
                                             (String
HasCallStack => String
failedAt
                                               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n expected length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ne
                                               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n actual length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
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 (m :: * -> *) a.
(AssertM m, HasCallStack) =>
ColorString -> m a
genericAssertFailure (String -> String -> ColorString -> ColorString
mkColorMsg String
"assertSetEqual" String
s
                                           (String -> ColorString
noColor String
HasCallStack => String
failedAt ColorString -> ColorString -> ColorString
+++ ColorString
x))
             | Bool
otherwise -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where unorderedEq :: [a] -> [a] -> Bool
unorderedEq [a]
l1 [a]
l2 =
              [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 (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 :: String -> [a] -> [a] -> m ()
gassertListsEqualAsSetsVerbose = String -> String -> [a] -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
String -> String -> [a] -> [a] -> m ()
assertListsEqualAsSets_ String
"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 :: [a] -> [a] -> m ()
gassertListsEqualAsSets= String -> String -> [a] -> [a] -> m ()
forall a (m :: * -> *).
(Eq a, Show a, AssertM m, HasCallStack) =>
String -> String -> [a] -> [a] -> m ()
assertListsEqualAsSets_ String
"gassertListsEqualAsSets" String
""

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

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

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

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

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

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

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

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

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

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

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

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

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

--
-- Assertions for Exceptions
--

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

assertThrowsSomeIO_ :: HasCallStack => String -> String -> IO a -> IO ()
assertThrowsSomeIO_ :: String -> String -> IO a -> IO ()
assertThrowsSomeIO_ String
name String
s IO a
x = String -> String -> IO a -> (SomeException -> Bool) -> IO ()
forall e a.
(HasCallStack, Exception e) =>
String -> String -> IO a -> (e -> Bool) -> IO ()
assertThrowsIO_ String
name String
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 :: String -> IO a -> IO ()
assertThrowsSomeIOVerbose = String -> String -> IO a -> IO ()
forall a. HasCallStack => String -> String -> IO a -> IO ()
assertThrowsSomeIO_ String
"assertThrowsSomeIOVerbose"

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

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

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

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

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

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

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

--
-- Assertions on Either
--

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

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

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

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

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

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

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

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

--
-- Assertions on Maybe
--

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

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

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

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

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

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

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

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

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

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

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

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

testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 =
    let msg :: String
msg = Text -> String
T.unpack (Text -> String) -> Text -> String
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 String -> String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
HU.assertEqual String
"error" String
msg String
exp
    where
      exp :: String
exp = String
"\n* expected: [1, 2, 3]\n* but got:  [1, 2, 3, 4]\n* " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"diff:     \nC <...[1, 2, 3...>C \nS , 4\nC ]<......>C "

testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 =
    let msg :: String
msg = Text -> String
T.unpack (Text -> String) -> Text -> String
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 String -> String -> String -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
HU.assertEqual String
"error" String
msg String
exp
    where
      exp :: String
exp = String
"\n* expected: [1,2,3]\n* but got:  [1,2,3]\n* " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"diff:     \nWARNING: strings are equal but actual values differ!"

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