{-# OPTIONS_GHC -cpp -pgmP "cpphs --layout --hashes --cpp" #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
module Test.Framework.HUnitWrapper (
assertBool_, assertBoolVerbose_,
gassertBool_, gassertBoolVerbose_,
assertEqual_, assertEqualVerbose_,
gassertEqual_, gassertEqualVerbose_,
assertEqualPretty_, assertEqualPrettyVerbose_,
gassertEqualPretty_, gassertEqualPrettyVerbose_,
assertEqualNoShow_, assertEqualNoShowVerbose_,
gassertEqualNoShow_, gassertEqualNoShowVerbose_,
assertNotEqual_, assertNotEqualVerbose_,
gassertNotEqual_, gassertNotEqualVerbose_,
assertNotEqualPretty_, assertNotEqualPrettyVerbose_,
gassertNotEqualPretty_, gassertNotEqualPrettyVerbose_,
assertNotEqualNoShow_, assertNotEqualNoShowVerbose_,
gassertNotEqualNoShow_, gassertNotEqualNoShowVerbose_,
assertListsEqualAsSets_, assertListsEqualAsSetsVerbose_,
gassertListsEqualAsSets_, gassertListsEqualAsSetsVerbose_,
assertNotEmpty_, assertNotEmptyVerbose_,
gassertNotEmpty_, gassertNotEmptyVerbose_,
assertEmpty_, assertEmptyVerbose_,
gassertEmpty_, gassertEmptyVerbose_,
assertElem_, assertElemVerbose_,
gassertElem_, gassertElemVerbose_,
assertThrows_, assertThrowsVerbose_,
assertThrowsSome_, assertThrowsSomeVerbose_,
assertThrowsIO_, assertThrowsIOVerbose_,
assertThrowsSomeIO_, assertThrowsSomeIOVerbose_,
assertThrowsM_, assertThrowsMVerbose_,
assertThrowsSomeM_, assertThrowsSomeMVerbose_,
assertLeft_, assertLeftVerbose_,
gassertLeft_, gassertLeftVerbose_,
assertLeftNoShow_, assertLeftNoShowVerbose_,
gassertLeftNoShow_, gassertLeftNoShowVerbose_,
assertRight_, assertRightVerbose_,
gassertRight_, gassertRightVerbose_,
assertRightNoShow_, assertRightNoShowVerbose_,
gassertRightNoShow_, gassertRightNoShowVerbose_,
assertJust_, assertJustVerbose_,
gassertJust_, gassertJustVerbose_,
assertNothing_, assertNothingVerbose_,
gassertNothing_, gassertNothingVerbose_,
assertNothingNoShow_, assertNothingNoShowVerbose_,
gassertNothingNoShow_, gassertNothingNoShowVerbose_,
assertFailure_,
gassertFailure_,
unitTestPending, unitTestPending',
subAssert_, subAssertVerbose_,
gsubAssert_, gsubAssertVerbose_,
HU.HUnitFailure,
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 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 qualified Data.Text as T
import qualified Data.List as List
gassertFailure_ :: AssertM m => Location -> String -> m a
gassertFailure_ :: Location -> String -> m a
gassertFailure_ Location
loc String
s =
Location -> ColorString -> m a
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
"assertFailure" String
""
(String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s))
assertFailure_ :: Location -> String -> IO a
assertFailure_ :: Location -> String -> IO a
assertFailure_ = Location -> String -> IO a
forall (m :: * -> *) a. AssertM m => Location -> String -> m a
gassertFailure_
unitTestPending :: String -> IO a
unitTestPending :: String -> IO a
unitTestPending String
s =
FullTestResult -> IO a
forall (m :: * -> *) a.
MonadBaseControl IO m =>
FullTestResult -> m a
failHTF (Maybe Location
-> [(Maybe String, Location)]
-> Maybe ColorString
-> Maybe TestResult
-> FullTestResult
FullTestResult Maybe Location
forall a. Maybe a
Nothing [] (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))
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
#define CreateAssertionsGenericNoGVariant(__name__, __ctx__, __type__, __ret__) \
__name__##Verbose_ :: __ctx__ Location -> String -> __type__ -> __ret__; \
__name__##Verbose_ = _##__name__##_ (#__name__ ++ "Verbose"); \
__name__##_ :: __ctx__ Location -> __type__ -> __ret__; \
__name__##_ loc = _##__name__##_ #__name__ loc ""
#define CreateAssertionsGeneric(__name__, __ctx__, __ctx2__, __type__, __ret__) \
g##__name__##Verbose_ :: __ctx2__ Location -> String -> __type__ -> m __ret__; \
g##__name__##Verbose_ = _##__name__##_ (#__name__ ++ "Verbose"); \
g##__name__##_ :: __ctx2__ Location -> __type__ -> m __ret__; \
g##__name__##_ loc = _##__name__##_ #__name__ loc ""; \
CreateAssertionsGenericNoGVariant(__name__, __ctx__, __type__, IO __ret__)
#define CreateAssertionsCtx(__name__, __ctx__, __ctx2__, __type__) \
CreateAssertionsGeneric(__name__, __ctx__ =>, __ctx2__ =>, __type__, ())
#define CreateAssertionsCtxNoGVariant(__name__, __ctx__, __type__) \
CreateAssertionsGenericNoGVariant(__name__, __ctx__ =>, __type__, IO ())
#define CreateAssertions(__name__, __type__) \
CreateAssertionsGeneric(__name__, , AssertM m =>, __type__, ())
#define CreateAssertionsNoGVariant(__name__, __type__) \
CreateAssertionsGenericNoGVariant(__name__, , __type__, IO ())
#define CreateAssertionsCtxRet(__name__, __ctx__, __ctx2__, __type__, __ret__) \
CreateAssertionsGeneric(__name__, __ctx__ =>, __ctx2__ =>, __type__, __ret__)
#define CreateAssertionsCtxRetNoGVariant(__name__, __ctx__, __type__, __ret__) \
CreateAssertionsGenericNoGVariant(__name__, __ctx__ =>, __type__, IO __ret__)
#define CreateAssertionsRet(__name__, __type__, __ret__) \
CreateAssertionsGeneric(__name__, , AssertM m =>, __type__, __ret__)
#define CreateAssertionsRetNoGVariant(__name__, __type__, __ret__) \
CreateAssertionsGenericNoGVariant(__name__, , __type__, IO __ret__)
#define DocAssertion(__name__, __text__) \
{- | __text__ The 'String' parameter in the @Verbose@ \
variants can be used to provide extra information about the error. The \
variants @g##__name__@ and @g##__name__##Verbose@ are generic assertions: \
they run in the IO monad and can be evaluated to a 'Bool' value. \
Do not use the \
@__name__##_@, @__name__##Verbose_@, @g##__name__##_@, and @g##__name__##Verbose_@ \
functions directly, use the macros @__name__@, @__name__##Verbose@, @g##__name__@, and \
@g##__name__##Verbose@ instead. These macros, provided by the @htfpp@ preprocessor, \
insert the 'Location' parameter automatically. -}
#define DocAssertionNoGVariant(__name__, __text__) \
{- | __text__ The 'String' parameter in the @Verbose@ \
variant can be used to provide extra information about the error. \
Do not use the \
@__name__##_@ and @__name__##Verbose_@ \
functions directly, use the macros @__name__@ and @__name__##Verbose@ \
instead. These macros, provided by the @htfpp@ preprocessor, \
insert the 'Location' parameter automatically. -}
_assertBool_ :: AssertM m => String -> Location -> String -> Bool -> m ()
_assertBool_ :: String -> Location -> String -> Bool -> m ()
_assertBool_ String
name Location
loc String
s Bool
False =
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc))
_assertBool_ String
_ Location
_ String
_ Bool
True = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertBool, Fail if the 'Bool' value is 'False'.)
CreateAssertions(assertBool, Bool)
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
100000
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
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)
_assertEqual_ :: (Eq a, Show a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertEqual_ :: String -> Location -> String -> a -> a -> m ()
_assertEqual_ String
name Location
loc 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
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> ColorString -> ColorString
mkColorMsg String
name String
s (ColorString -> ColorString) -> ColorString -> ColorString
forall a b. (a -> b) -> a -> b
$
String -> ColorString
noColor (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc) ColorString -> ColorString -> ColorString
+++ ColorString
x)
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertEqual, Fail if the two values of type @a@ are not equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is an instance of 'Show' but not of 'Pretty'.)
CreateAssertionsCtx(assertEqual, (Eq a, Show a), (Eq a, Show a, AssertM m), a -> a)
_assertNotEqual_ :: (Eq a, Show a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertNotEqual_ :: String -> Location -> String -> a -> a -> m ()
_assertNotEqual_ String
name Location
loc 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
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String -> ColorString) -> String -> ColorString
forall a b. (a -> b) -> a -> b
$ String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertNotEqual, Fail if the two values of type @a@ are equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is an instance of 'Show' but not of 'Pretty'.)
CreateAssertionsCtx(assertNotEqual, (Eq a, Show a), (Eq a, Show a, AssertM m), a -> a)
_assertEqualPretty_ :: (Eq a, Pretty a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertEqualPretty_ :: String -> Location -> String -> a -> a -> m ()
_assertEqualPretty_ String
name Location
loc 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)
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> ColorString -> ColorString
mkColorMsg String
name String
s
(String -> ColorString
noColor (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc) ColorString -> ColorString -> ColorString
+++ ColorString
x))
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertEqualPretty, Fail if the two values of type @a@ are not equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is an instance of 'Pretty'.)
CreateAssertionsCtx(assertEqualPretty, (Eq a, Pretty a), (Eq a, Pretty a, AssertM m), a -> a)
_assertNotEqualPretty_ :: (Eq a, Pretty a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertNotEqualPretty_ :: String -> Location -> String -> a -> a -> m ()
_assertNotEqualPretty_ String
name Location
loc 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)
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String -> ColorString) -> String -> ColorString
forall a b. (a -> b) -> a -> b
$ String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertNotEqualPretty, Fail if the two values of type @a@ are equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is an instance of 'Pretty'.)
CreateAssertionsCtx(assertNotEqualPretty, (Eq a, Pretty a), (Eq a, Pretty a, AssertM m), a -> a)
_assertEqualNoShow_ :: (Eq a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertEqualNoShow_ :: String -> Location -> String -> a -> a -> m ()
_assertEqualNoShow_ String
name Location
loc String
s a
expected a
actual =
if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
actual
then Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc))
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertEqualNoShow, Fail if the two values of type @a@ are not equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is neither an instance of 'Show' nor 'Pretty'. Be aware that in this
case the generated error message might not be very helpful.)
CreateAssertionsCtx(assertEqualNoShow, Eq a, (Eq a, AssertM m), a -> a)
_assertNotEqualNoShow_ :: (Eq a, AssertM m)
=> String -> Location -> String -> a -> a -> m ()
_assertNotEqualNoShow_ :: String -> Location -> String -> a -> a -> m ()
_assertNotEqualNoShow_ String
name Location
loc String
s a
expected a
actual =
if a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual
then Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc))
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertNotEqualNoShow, Fail if the two values of type @a@ are equal.
The first parameter denotes the expected value. Use these two functions
of @a@ is neither an instance of 'Show' nor 'Pretty'. Be aware that in this
case the generated error message might not be very helpful.)
CreateAssertionsCtx(assertNotEqualNoShow, Eq a, (Eq a, AssertM m), a -> a)
_assertListsEqualAsSets_ :: (Eq a, Show a, AssertM m)
=> String -> Location -> String -> [a] -> [a] -> m ()
_assertListsEqualAsSets_ :: String -> Location -> String -> [a] -> [a] -> m ()
_assertListsEqualAsSets_ String
name Location
loc 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
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> ColorString -> ColorString
mkColorMsg String
name String
s
(String -> ColorString
noColor
(String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc
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
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> ColorString -> ColorString
mkColorMsg String
"assertSetEqual" String
s
(String -> ColorString
noColor (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc) 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)
DocAssertion(assertListsEqualAsSets, Fail if the two given lists are not equal
when considered as sets. The first list parameter
denotes the expected value.)
CreateAssertionsCtx(assertListsEqualAsSets, (Eq a, Show a), (Eq a, Show a, AssertM m), [a] -> [a])
_assertNotEmpty_ :: AssertM m => String -> Location -> String -> [a] -> m ()
_assertNotEmpty_ :: String -> Location -> String -> [a] -> m ()
_assertNotEmpty_ String
name Location
loc String
s [] =
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc))
_assertNotEmpty_ String
_ Location
_ String
_ (a
_:[a]
_) = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertNotEmpty, Fail if the given list is empty.)
CreateAssertions(assertNotEmpty, [a])
_assertEmpty_ :: AssertM m => String -> Location -> String -> [a] -> m ()
_assertEmpty_ :: String -> Location -> String -> [a] -> m ()
_assertEmpty_ String
name Location
loc String
s (a
_:[a]
_) =
Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s (String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc))
_assertEmpty_ String
_ Location
_ String
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DocAssertion(assertEmpty, Fail if the given list is a non-empty list.)
CreateAssertions(assertEmpty, [a])
_assertElem_ :: (Eq a, Show a, AssertM m) => String -> Location -> String -> a -> [a] -> m ()
_assertElem_ :: String -> Location -> String -> a -> [a] -> m ()
_assertElem_ String
name Location
loc 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 Location -> ColorString -> m ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s
(String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc 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))
DocAssertion(assertElem, Fail if the given element is not in the list.)
CreateAssertionsCtx(assertElem, (Eq a, Show a), (Eq a, Show a, AssertM m), a -> [a])
_assertThrowsIO_ :: Exception e
=> String -> Location -> String -> IO a -> (e -> Bool) -> IO ()
_assertThrowsIO_ :: String -> Location -> String -> IO a -> (e -> Bool) -> IO ()
_assertThrowsIO_ String
name Location
loc String
s IO a
x e -> Bool
f =
String -> Location -> String -> IO a -> (e -> Bool) -> IO ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, MonadIO m, Exception e) =>
String -> Location -> String -> m a -> (e -> Bool) -> m ()
_assertThrowsM_ String
name Location
loc String
s IO a
x e -> Bool
f
DocAssertionNoGVariant(assertThrowsIO, Fail if executing the 'IO' action does not
throw an exception satisfying the given predicate @(e -> Bool)@.)
CreateAssertionsCtxNoGVariant(assertThrowsIO, Exception e, IO a -> (e -> Bool))
_assertThrowsSomeIO_ :: String -> Location -> String -> IO a -> IO ()
_assertThrowsSomeIO_ :: String -> Location -> String -> IO a -> IO ()
_assertThrowsSomeIO_ String
name Location
loc String
s IO a
x = String
-> Location -> String -> IO a -> (SomeException -> Bool) -> IO ()
forall e a.
Exception e =>
String -> Location -> String -> IO a -> (e -> Bool) -> IO ()
_assertThrowsIO_ String
name Location
loc String
s IO a
x (\ (SomeException
_e::SomeException) -> Bool
True)
DocAssertionNoGVariant(assertThrowsSomeIO, Fail if executing the 'IO' action does not
throw an exception.)
CreateAssertionsNoGVariant(assertThrowsSomeIO, IO a)
_assertThrowsM_ :: (MonadBaseControl IO m, MonadIO m, Exception e)
=> String -> Location -> String -> m a -> (e -> Bool) -> m ()
_assertThrowsM_ :: String -> Location -> String -> m a -> (e -> Bool) -> m ()
_assertThrowsM_ String
name Location
loc 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
$
Location -> ColorString -> IO ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s
(String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Location -> String
showLoc Location
loc 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
$
Location -> ColorString -> IO ()
forall (m :: * -> *) a. AssertM m => Location -> ColorString -> m a
genericAssertFailure__ Location
loc (String -> String -> String -> ColorString
mkMsg String
name String
s
(String
"failed at " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Location -> String
showLoc Location
loc 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))
DocAssertionNoGVariant(assertThrowsM, Fail if executing the 'm' action does not
throw an exception satisfying the given predicate @(e -> Bool)@.)
CreateAssertionsGenericNoGVariant(assertThrowsM, (MonadBaseControl IO m, MonadIO m, Exception e) =>,
m a -> (e -> Bool), m ())
_assertThrowsSomeM_ :: (MonadBaseControl IO m, MonadIO m)
=> String -> Location -> String -> m a -> m ()
_assertThrowsSomeM_ name loc s x = _assertThrowsM_ name loc s x (\ (_e::SomeException) -> True)
DocAssertionNoGVariant(assertThrowsSomeM, Fail if executing the 'm' action does not
throw an exception.)
CreateAssertionsGenericNoGVariant(assertThrowsSomeM, (MonadBaseControl IO m, MonadIO m) =>, m a, m ())
_assertThrows_ :: Exception e
=> String -> Location -> String -> a -> (e -> Bool) -> IO ()
_assertThrows_ name loc s x f = _assertThrowsIO_ name loc s (evaluate x) f
DocAssertionNoGVariant(assertThrows, Fail if evaluating the expression of type @a@ does not
throw an exception satisfying the given predicate @(e -> Bool)@.)
CreateAssertionsCtxNoGVariant(assertThrows, Exception e, a -> (e -> Bool))
_assertThrowsSome_ :: String -> Location -> String -> a -> IO ()
_assertThrowsSome_ :: String -> Location -> String -> a -> IO ()
_assertThrowsSome_ name loc s x =
_assertThrows_ name loc s x (\ (_e::SomeException) -> True)
DocAssertionNoGVariant(assertThrowsSome, Fail if evaluating the expression of type @a@ does not
throw an exception.)
CreateAssertionsNoGVariant(assertThrowsSome, a)
_assertLeft_ :: forall a b m . (AssertM m, Show b)
=> String -> Location -> String -> Either a b -> m a
_assertLeft_ _ _ _ (Left x) = return x
_assertLeft_ name loc s (Right x) =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected a Left value, given " ++
show (Right x :: Either b b)))
DocAssertion(assertLeft, Fail if the given @Either a b@ value is a 'Right'.
Use this function if @b@ is an instance of 'Show')
CreateAssertionsCtxRet(assertLeft, Show b, (Show b, AssertM m), Either a b, a)
_assertLeftNoShow_ :: String -> Location -> String -> Either a b -> m a
_assertLeftNoShow_ :: AssertM m => String -> Location -> String -> Either a b -> m a
_assertLeftNoShow_ _ _ _ (Left x) = return x
_assertLeftNoShow_ name loc s (Right _) =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected a Left value, given a Right value"))
DocAssertion(assertLeftNoShow, Fail if the given @Either a b@ value is a 'Right'.)
CreateAssertionsRet(assertLeftNoShow, Either a b, a)
_assertRight_ :: forall a b m . (Show a, AssertM m)
=> String -> Location -> String -> Either a b -> m b
_assertRight_ _ _ _ (Right x) = return x
_assertRight_ name loc s (Left x) =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected a Right value, given " ++
show (Left x :: Either a a)))
DocAssertion(assertRight, Fail if the given @Either a b@ value is a 'Left'.
Use this function if @a@ is an instance of 'Show')
CreateAssertionsCtxRet(assertRight, Show a, (Show a, AssertM m), Either a b, b)
_assertRightNoShow_ :: String -> Location -> String -> Either a b -> m b
_assertRightNoShow_ :: AssertM m => String -> Location -> String -> Either a b -> m b
_assertRightNoShow_ _ _ _ (Right x) = return x
_assertRightNoShow_ name loc s (Left _) =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected a Right value, given a Left value"))
DocAssertion(assertRightNoShow, Fail if the given @Either a b@ value is a 'Left'.)
CreateAssertionsRet(assertRightNoShow, Either a b, b)
_assertJust_ :: String -> Location -> String -> Maybe a -> m a
_assertJust_ :: AssertM m => String -> Location -> String -> Maybe a -> m a
_assertJust_ _ _ _ (Just x) = return x
_assertJust_ name loc s Nothing =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected a Just value, given Nothing"))
DocAssertion(assertJust, Fail is the given @Maybe a@ value is a 'Nothing'.)
CreateAssertionsRet(assertJust, Maybe a, a)
_assertNothing_ :: (Show a, AssertM m)
=> String -> Location -> String -> Maybe a -> m ()
_assertNothing_ _ _ _ Nothing = return ()
_assertNothing_ name loc s jx =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected Nothing, given " ++ show jx))
DocAssertion(assertNothing, Fail is the given @Maybe a@ value is a 'Just'.
Use this function if @a@ is an instance of 'Show'.)
CreateAssertionsCtx(assertNothing, Show a, (Show a, AssertM m), Maybe a)
_assertNothingNoShow_ :: String -> Location -> String -> Maybe a -> m ()
_assertNothingNoShow_ :: AssertM m => String -> Location -> String -> Maybe a -> m ()
_assertNothingNoShow_ _ _ _ Nothing = return ()
_assertNothingNoShow_ name loc s _ =
genericAssertFailure__ loc (mkMsg name s
("failed at " ++ showLoc loc ++
": expected Nothing, given a Just value"))
DocAssertion(assertNothingNoShow, Fail is the given @Maybe a@ value is a 'Just'.)
CreateAssertions(assertNothingNoShow, Maybe a)
subAssert_ :: Location -> m a -> m a
subAssert_ :: MonadBaseControl IO m => Location -> m a -> m a
subAssert_ loc ass = subAssertHTF loc Nothing ass
gsubAssert_ :: Location -> m a -> m a
gsubAssert_ :: AssertM m => Location -> m a -> m a
gsubAssert_ loc ass = genericSubAssert loc Nothing ass
subAssertVerbose_ :: Location -> String -> m a -> m a
subAssertVerbose_ :: MonadBaseControl IO m => Location -> String -> m a -> m a
subAssertVerbose_ loc msg ass = subAssertHTF loc (Just msg) ass
gsubAssertVerbose_ :: Location -> String -> m a -> m a
gsubAssertVerbose_ :: AssertM m => Location -> String -> m a -> m a
gsubAssertVerbose_ loc msg ass = genericSubAssert loc (Just msg) ass
testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 :: IO ()
testEqualityFailedMessage1 =
let msg = T.unpack $ renderColorString (equalityFailedMessage [1,2,3] [1,2,3,4]) False
in HU.assertEqual "error" msg exp
where
exp = "\n* expected: [1, 2, 3]\n* but got: [1, 2, 3, 4]\n* " ++
"diff: \nC <...[1, 2, 3...>C \nS , 4\nC ]<......>C "
testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 :: IO ()
testEqualityFailedMessage2 =
let msg = T.unpack $ renderColorString (equalityFailedMessage [1,2,3] [1,2,3]) False
in HU.assertEqual "error" msg exp
where
exp = "\n* expected: [1,2,3]\n* but got: [1,2,3]\n* " ++
"diff: \nWARNING: strings are equal but actual values differ!"
hunitWrapperTests =
[("testEqualityFailedMessage1", testEqualityFailedMessage1)
,("testEqualityFailedMessage2", testEqualityFailedMessage2)]