{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuantifiedConstraints #-}

-- | This module exports hedgehog comparison tests
--   that don't contain CallStack information, since this would
--   expose library internals in error messages.
module Hedgehog.Classes.Common.Property
  ( heq, heq1, heq2
  , heqCtx, heqCtx1, heqCtx2
  , hneq, hneq1, hneq2
  , hneqCtx, hneqCtx1, hneqCtx2
  , himplCtx
  , hLessThan, hGreaterThan
  , hLessThanCtx, hGreaterThanCtx
  , bar
  , Context(..)
  ) where

import Control.Exception (SomeException(..), displayException)
import Data.Typeable (typeOf)
import GHC.Stack
import Hedgehog.Classes.Common.Compat
import Hedgehog.Internal.Exception (tryEvaluate)
import Hedgehog.Internal.Property (MonadTest, liftTest, mkTest, success, discard, Failure(..), PropertyT)
import Text.Show.Pretty (ppShow)
import qualified Data.Char as Char
import qualified Data.List as List

bar :: String
bar :: String
bar = String
"━━━"

bar5 :: String
bar5 :: String
bar5 = String
"━━━━━━━━━━━━━━━"

evalNoSrc :: (MonadTest m, HasCallStack) => a -> m a
evalNoSrc :: a -> m a
evalNoSrc a
x = (SomeException -> m a)
-> (a -> m a) -> Either SomeException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((HasCallStack => SomeException -> m a) -> SomeException -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => SomeException -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
SomeException -> m a
failExceptionNoSrc) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either SomeException a
forall a. a -> Either SomeException a
tryEvaluate a
x)

failWithNoSrc :: (MonadTest m, HasCallStack) => String -> m a
failWithNoSrc :: String -> m a
failWithNoSrc String
msg = do
  Test a -> m a
forall (m :: * -> *) a. MonadTest m => Test a -> m a
liftTest (Test a -> m a) -> Test a -> m a
forall a b. (a -> b) -> a -> b
$ (Either Failure a, Journal) -> Test a
forall a. (Either Failure a, Journal) -> Test a
mkTest (Failure -> Either Failure a
forall a b. a -> Either a b
Left (Failure -> Either Failure a) -> Failure -> Either Failure a
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Maybe Diff -> Failure
Failure Maybe Span
forall a. Maybe a
Nothing String
msg Maybe Diff
forall a. Maybe a
Nothing, Journal
forall a. Monoid a => a
mempty)

failExceptionNoSrc :: (MonadTest m, HasCallStack) => SomeException -> m a
failExceptionNoSrc :: SomeException -> m a
failExceptionNoSrc (SomeException e
x) = (HasCallStack => m a) -> m a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m a) -> m a) -> (HasCallStack => m a) -> m a
forall a b. (a -> b) -> a -> b
$
  String -> m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
String -> m a
failWithNoSrc (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    [ String
bar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar
      , (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd Char -> Bool
Char.isSpace (e -> String
forall e. Exception e => e -> String
displayException e
x)
    ]

-- | You can provide a 'Context' to 'heqCtx','heqCtx1','heqCtx2','hneqCtx','hneqCtx1',or 'hneqCtx2'. The 'Context' is used to provide useful error messages in the event of a failure.
data Context = NoContext | Context String

contextToString :: Context -> String
contextToString :: Context -> String
contextToString = \case
  Context
NoContext -> String
"No Context provided."
  Context String
ctx -> String
bar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Context " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar5

failContext::
  ( MonadTest m, HasCallStack
  ) => Context -> m ()
failContext :: Context -> m ()
failContext Context
ctx = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
  String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
String -> m a
failWithNoSrc (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> String
contextToString Context
ctx

-- | Fails the test with the given context if the right argument is
--   less than or equal to the left.
hLessThanCtx ::
  ( MonadTest m
  , Ord a
  , Show a
  , HasCallStack
  ) => a -> a -> Context -> m ()
hLessThanCtx :: a -> a -> Context -> m ()
hLessThanCtx a
x a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Fails the test with the given context if the right argument is
--   greater than or equal to the left.
hGreaterThanCtx ::
  ( MonadTest m
  , Ord a
  , Show a
  , HasCallStack
  ) => a -> a -> Context -> m ()
hGreaterThanCtx :: a -> a -> Context -> m ()
hGreaterThanCtx a
x a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Fails the test if the right argument is less than or equal to the left.
-- see https://github.com/hedgehogqa/haskell-hedgehog/pull/196
hLessThan :: (MonadTest m, Ord a, Show a, HasCallStack) => a -> a -> m ()
hLessThan :: a -> a -> m ()
hLessThan a
x a
y = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
String -> m a
failWithNoSrc (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ String
bar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Not Less Than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar
      , a -> String
forall a. Show a => a -> String
ppShow a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not less than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
ppShow a
y
      ]

-- | Fails the test if the right argument is greater than or equal to the left.
-- see https://github.com/hedgehogqa/haskell-hedgehog/pull/196
hGreaterThan :: (MonadTest m, Ord a, Show a, HasCallStack) => a -> a -> m ()
hGreaterThan :: a -> a -> m ()
hGreaterThan a
x a
y = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
String -> m a
failWithNoSrc (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ String
bar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Not Greater Than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar
      , a -> String
forall a. Show a => a -> String
ppShow a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
ppShow a
y
      ]

infix 4 `hneq`

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with the given 'Context'.
hneqCtx ::
  ( MonadTest m
  , HasCallStack
  , Eq a
  , Show a
  ) => a -> a -> Context -> m ()
hneqCtx :: a -> a -> Context -> m ()
hneqCtx a
x a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
`neq` a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with 'NoContext'.
hneq ::
  ( MonadTest m
  , HasCallStack
  , Eq a
  , Show a
  ) => a -> a -> m ()
hneq :: a -> a -> m ()
hneq a
x a
y = a -> a -> Context -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
hneqCtx a
x a
y Context
NoContext

infix 4 `heq`

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with the given 'Context'.
heqCtx ::
    ( MonadTest m
    , HasCallStack
    , Eq a
    , Show a
    ) => a -> a -> Context -> m ()
heqCtx :: a -> a -> Context -> m ()
heqCtx a
x a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
`eq` a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with 'NoContext'.
heq ::
    ( MonadTest m
    , HasCallStack
    , Eq a
    , Show a
    ) => a -> a -> m ()
heq :: a -> a -> m ()
heq a
x a
y = a -> a -> Context -> m ()
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
x a
y Context
NoContext

infix 4 `heq1`

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with the given 'Context'.
hneqCtx1 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Show a
     , forall x. Eq x => Eq (f x)
     , forall x. Show x => Show (f x)
     ) => f a -> f a -> Context -> m ()
hneqCtx1 :: f a -> f a -> Context -> m ()
hneqCtx1 f a
x f a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (f a
x f a -> f a -> Bool
forall a (f :: * -> *).
(Eq a, forall x. Eq x => Eq (f x)) =>
f a -> f a -> Bool
`neq1` f a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with 'NoContext'.
hneq1 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Show a
     , forall x. Eq x => Eq (f x)
     , forall x. Show x => Show (f x)
     ) => f a -> f a -> m ()
hneq1 :: f a -> f a -> m ()
hneq1 f a
x f a
y = f a -> f a -> Context -> m ()
forall (m :: * -> *) a (f :: * -> *).
(MonadTest m, HasCallStack, Eq a, Show a,
 forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)) =>
f a -> f a -> Context -> m ()
hneqCtx1 f a
x f a
y Context
NoContext

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with the given 'Context'.
heqCtx1 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Show a
     , forall x. Eq x => Eq (f x)
     , forall x. Show x => Show (f x)
     ) => f a -> f a -> Context -> m ()
heqCtx1 :: f a -> f a -> Context -> m ()
heqCtx1 f a
x f a
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (f a
x f a -> f a -> Bool
forall a (f :: * -> *).
(Eq a, forall x. Eq x => Eq (f x)) =>
f a -> f a -> Bool
`eq1` f a
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with 'NoContext'.
heq1 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Show a
     , forall x. Eq x => Eq (f x)
     , forall x. Show x => Show (f x)
     ) => f a -> f a -> m ()
heq1 :: f a -> f a -> m ()
heq1 f a
x f a
y = f a -> f a -> Context -> m ()
forall (m :: * -> *) a (f :: * -> *).
(MonadTest m, HasCallStack, Eq a, Show a,
 forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)) =>
f a -> f a -> Context -> m ()
heqCtx1 f a
x f a
y Context
NoContext

infix 4 `heq2`

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with the given 'Context'.
heqCtx2 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Eq b
     , Show a
     , Show b
     , forall x y. (Eq x, Eq y) => Eq (f x y)
     , forall x y. (Show x, Show y) => Show (f x y)
     ) => f a b -> f a b -> Context -> m ()
heqCtx2 :: f a b -> f a b -> Context -> m ()
heqCtx2 f a b
x f a b
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (f a b
x f a b -> f a b -> Bool
forall a b (f :: * -> * -> *).
(Eq a, Eq b, forall x y. (Eq x, Eq y) => Eq (f x y)) =>
f a b -> f a b -> Bool
`eq2` f a b
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are equal. Otherwise fails
--   with 'NoContext'.
heq2 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Eq b
     , Show a
     , Show b
     , forall x y. (Eq x, Eq y) => Eq (f x y)
     , forall x y. (Show x, Show y) => Show (f x y)
     ) => f a b -> f a b -> m ()
heq2 :: f a b -> f a b -> m ()
heq2 f a b
x f a b
y = f a b -> f a b -> Context -> m ()
forall (m :: * -> *) a b (f :: * -> * -> *).
(MonadTest m, HasCallStack, Eq a, Eq b, Show a, Show b,
 forall x y. (Eq x, Eq y) => Eq (f x y),
 forall x y. (Show x, Show y) => Show (f x y)) =>
f a b -> f a b -> Context -> m ()
heqCtx2 f a b
x f a b
y Context
NoContext

infix 4 `hneq2`

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with the given 'Context'.
hneqCtx2 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Eq b
     , Show a
     , Show b
     , forall x y. (Eq x, Eq y) => Eq (f x y)
     , forall x y. (Show x, Show y) => Show (f x y)
     ) => f a b -> f a b -> Context -> m ()
hneqCtx2 :: f a b -> f a b -> Context -> m ()
hneqCtx2 f a b
x f a b
y Context
ctx = do
  Bool
ok <- (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
evalNoSrc (f a b
x f a b -> f a b -> Bool
forall a b (f :: * -> * -> *).
(Eq a, Eq b, forall x y. (Eq x, Eq y) => Eq (f x y)) =>
f a b -> f a b -> Bool
`neq2` f a b
y)
  if Bool
ok
    then m ()
forall (m :: * -> *). MonadTest m => m ()
success
    else (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Context -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx

-- | Passes the test if the given arguments are not equal. Otherwise fails
--   with 'NoContext'.
hneq2 ::
     ( MonadTest m
     , HasCallStack
     , Eq a
     , Eq b
     , Show a
     , Show b
     , forall x y. (Eq x, Eq y) => Eq (f x y)
     , forall x y. (Show x, Show y) => Show (f x y)
     ) => f a b -> f a b -> m ()
hneq2 :: f a b -> f a b -> m ()
hneq2 f a b
x f a b
y = f a b -> f a b -> Context -> m ()
forall (m :: * -> *) a b (f :: * -> * -> *).
(MonadTest m, HasCallStack, Eq a, Eq b, Show a, Show b,
 forall x y. (Eq x, Eq y) => Eq (f x y),
 forall x y. (Show x, Show y) => Show (f x y)) =>
f a b -> f a b -> Context -> m ()
hneqCtx2 f a b
x f a b
y Context
NoContext

-- | Passes the test if the LHS implies the RHS. Otherwise fails with
--   the given 'Context'.
himplCtx ::
    ( Monad m
    , HasCallStack
    ) => Bool -> Bool -> Context -> PropertyT m ()
himplCtx :: Bool -> Bool -> Context -> PropertyT m ()
himplCtx Bool
False Bool
_ Context
_ = PropertyT m ()
forall (m :: * -> *) a. Monad m => PropertyT m a
discard
himplCtx Bool
True Bool
b Context
ctx = if Bool
b
  then PropertyT m ()
forall (m :: * -> *). MonadTest m => m ()
success
  else (HasCallStack => PropertyT m ()) -> PropertyT m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT m ()) -> PropertyT m ())
-> (HasCallStack => PropertyT m ()) -> PropertyT m ()
forall a b. (a -> b) -> a -> b
$ Context -> PropertyT m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
Context -> m ()
failContext Context
ctx