{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.Validity.Operations.Associativity
    ( associativeOnGens
    , associativeOnValids
    , associative
    , associativeOnArbitrary
    ) where

import Data.GenValidity

import Test.Syd
import Test.QuickCheck

-- |
--
-- \[
--     Associative(\star)
--     \quad\equiv\quad
--     \forall a, b, c:
--     (a \star b) \star c = a \star (b \star c)
-- \]
associativeOnGens ::
       (Show a, Eq a)
    => (a -> a -> a)
    -> Gen (a, a, a)
    -> ((a, a, a) -> [(a, a, a)])
    -> Property
associativeOnGens :: (a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
associativeOnGens a -> a -> a
op Gen (a, a, a)
gen (a, a, a) -> [(a, a, a)]
s =
    Gen (a, a, a)
-> ((a, a, a) -> [(a, a, a)]) -> ((a, a, a) -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, a, a)
gen (a, a, a) -> [(a, a, a)]
s (((a, a, a) -> IO ()) -> Property)
-> ((a, a, a) -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, a
b, a
c) ->
        ((a
a a -> a -> a
`op` a
b) a -> a -> a
`op` a
c) a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` (a
a a -> a -> a
`op` (a
b a -> a -> a
`op` a
c))

associativeOnValids :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> Property
associativeOnValids :: (a -> a -> a) -> Property
associativeOnValids a -> a -> a
op = (a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
forall a.
(Show a, Eq a) =>
(a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
associativeOnGens a -> a -> a
op Gen (a, a, a)
forall a. GenValid a => Gen a
genValid (a, a, a) -> [(a, a, a)]
forall a. GenValid a => a -> [a]
shrinkValid

-- |
--
-- prop> associative ((*) :: Int -> Int -> Int)
-- prop> associative ((+) :: Int -> Int -> Int)
associative :: (Show a, Eq a, GenUnchecked a) => (a -> a -> a) -> Property
associative :: (a -> a -> a) -> Property
associative a -> a -> a
op = (a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
forall a.
(Show a, Eq a) =>
(a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
associativeOnGens a -> a -> a
op Gen (a, a, a)
forall a. GenUnchecked a => Gen a
genUnchecked (a, a, a) -> [(a, a, a)]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

-- |
--
-- prop> associativeOnArbitrary ((*) :: Int -> Int -> Int)
-- prop> associativeOnArbitrary ((+) :: Int -> Int -> Int)
associativeOnArbitrary ::
       (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property
associativeOnArbitrary :: (a -> a -> a) -> Property
associativeOnArbitrary a -> a -> a
op = (a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
forall a.
(Show a, Eq a) =>
(a -> a -> a)
-> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
associativeOnGens a -> a -> a
op Gen (a, a, a)
forall a. Arbitrary a => Gen a
arbitrary (a, a, a) -> [(a, a, a)]
forall a. Arbitrary a => a -> [a]
shrink