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

module Test.PartialSemigroup.Hedgehog
  ( assoc
  ) where

-- partial-semigroup
import Data.PartialSemigroup (PartialSemigroup (..))

-- hedgehog
import Hedgehog (Gen, Property, forAll, property, (===))

{- | 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 (m :: * -> *) a. Monad m => a -> m a
return (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)