{-# LANGUAGE OverloadedStrings #-}
module Hedgehog.Laws.Common where

import Hedgehog (Property, cover, forAll, property)
import Hedgehog qualified
import Prelude

implies :: Bool -> Bool -> Bool
implies :: Bool -> Bool -> Bool
implies Bool
x Bool
y = Bool -> Bool
not Bool
x Bool -> Bool -> Bool
|| Bool
y

prop_idempotent :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> a) -> Property
prop_idempotent :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> a) -> Property
prop_idempotent Gen a
g a -> a -> a
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
x a -> a -> a
`op` a
x a -> a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== a
x

prop_commutative :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> a) -> Property
prop_commutative :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> a) -> Property
prop_commutative Gen a
g a -> a -> a
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  a
x a -> a -> a
`op` a
y a -> a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== a
y a -> a -> a
`op` a
x

prop_associative :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> a) -> Property
prop_associative :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> a) -> Property
prop_associative Gen a
g a -> a -> a
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
z <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
z
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
|| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z Bool -> Bool -> Bool
|| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
  (a
x a -> a -> a
`op` a
y) a -> a -> a
`op` a
z a -> a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== a
x a -> a -> a
`op` (a
y a -> a -> a
`op` a
z)

prop_unit :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> a) -> a -> Property
prop_unit :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> a) -> a -> Property
prop_unit Gen a
g a -> a -> a
op a
unit = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
unit
  a
x a -> a -> a
`op` a
unit a -> a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== a
x

prop_reflexive :: (Show a) => Hedgehog.Gen a -> (a -> a -> Bool) -> Property
prop_reflexive :: forall a. Show a => Gen a -> (a -> a -> Bool) -> Property
prop_reflexive Gen a
g a -> a -> Bool
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
x a -> a -> Bool
`op` a
x Bool -> Bool -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== Bool
True

prop_symmetric :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> Bool) -> Property
prop_symmetric :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> Bool) -> Property
prop_symmetric Gen a
g a -> a -> Bool
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  a
x a -> a -> Bool
`op` a
y Bool -> Bool -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
Hedgehog.=== a
y a -> a -> Bool
`op` a
x

prop_transitive :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> Bool) -> Property
prop_transitive :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> Bool) -> Property
prop_transitive Gen a
g a -> a -> Bool
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
z <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
z
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
|| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z Bool -> Bool -> Bool
|| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ (a
x a -> a -> Bool
`op` a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
`op` a
z) Bool -> Bool -> Bool
`implies` (a
x a -> a -> Bool
`op` a
z)

prop_antisymmetric :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> Bool) -> Property
prop_antisymmetric :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> Bool) -> Property
prop_antisymmetric Gen a
g a -> a -> Bool
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ (a
x a -> a -> Bool
`op` a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
`op` a
x) Bool -> Bool -> Bool
`implies` (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y)

prop_total :: (Show a, Eq a) => Hedgehog.Gen a -> (a -> a -> Bool) -> Property
prop_total :: forall a. (Show a, Eq a) => Gen a -> (a -> a -> Bool) -> Property
prop_total Gen a
g a -> a -> Bool
op = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
x <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
g
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
10 LabelName
"different" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y
  CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover CoverPercentage
5 LabelName
"same" (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
`op` a
y Bool -> Bool -> Bool
|| a
y a -> a -> Bool
`op` a
x