{- | Utilities for testing partial semigroups using the hedgehog property
testing library. -}

module Test.PartialSemigroup.Hedgehog (assoc) where

import Data.PartialSemigroup (PartialSemigroup (..))
import Hedgehog (Gen, Property, forAll, property, (===))
import Prelude (($), Eq, Show, pure, sequence_)

{- | The partial semigroup associativity axiom:

For all @x@, @y@, @z@: If @x '<>?' y = 'Just' xy@ and @y '<>?' z = 'Just' yz@,
then @x '<>?' yz = xy '<>?' z@. -}
assoc :: (PartialSemigroup a, Eq a, Show a) => Gen a -> Property
assoc :: forall a. (PartialSemigroup a, Eq a, Show a) => Gen a -> Property
assoc Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
    a
x <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
    a
y <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
    a
z <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ do
        a
xy <- a
x forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
y
        a
yz <- a
y forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
z
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
yz forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
xy forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
z)