{- | 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 :: Gen a -> Property
assoc Gen a
gen = 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
gen
    a
y <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
    a
z <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
    Maybe (PropertyT IO ()) -> PropertyT IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (PropertyT IO ()) -> PropertyT IO ())
-> Maybe (PropertyT IO ()) -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
        a
xy <- a
x a -> a -> Maybe a
forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
y
        a
yz <- a
y a -> a -> Maybe a
forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
z
        PropertyT IO () -> Maybe (PropertyT IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> a -> Maybe a
forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
yz Maybe a -> Maybe a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== a
xy a -> a -> Maybe a
forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
z)