Identity.hs

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

module Test.Validity.Operations.Identity
    ( leftIdentityOnElemWithEquality
    , leftIdentityOnGenWithEquality
    , leftIdentityOnGen
    , leftIdentityOnValid
    , leftIdentity
    , leftIdentityOnArbitrary
    , rightIdentityOnElemWithEquality
    , rightIdentityOnGenWithEquality
    , rightIdentityOnGen
    , rightIdentityOnValid
    , rightIdentity
    , rightIdentityOnArbitrary
    , identityOnGen
    , identityOnValid
    , identity
    , identityOnArbitrary
    ) where

import Data.GenValidity

import Test.QuickCheck

-- |
--
-- \[
--   LeftIdentity(\star, \doteq, b)
--   \quad\equiv\quad
--   \forall a: (b \star a) \doteq a
-- \]
leftIdentityOnElemWithEquality
    :: (b -> a -> a) -- ^ A binary operation
    -> (a -> a -> Bool) -- ^ An equality
    -> b -- ^ A candidate left-identity
    -> a -- ^ An element
    -> Bool
leftIdentityOnElemWithEquality op eq b a = (b `op` a) `eq` a

leftIdentityOnGenWithEquality
    :: Show a
    => (b -> a -> a) -- ^ A binary operation
    -> (a -> a -> Bool) -- ^ An equality
    -> b -- ^ A candidate left-identity
    -> Gen a
    -> Property
leftIdentityOnGenWithEquality op eq b gen =
    forAll gen $ leftIdentityOnElemWithEquality op eq b

leftIdentityOnGen
    :: (Show a, Eq a)
    => (b -> a -> a) -- ^ A binary operation
    -> b -- ^ A candidate left-identity
    -> Gen a
    -> Property
leftIdentityOnGen op = leftIdentityOnGenWithEquality op (==)

-- |
--
-- prop> leftIdentityOnValid (flip ((^) :: Double -> Int -> Double)) 1
leftIdentityOnValid
    :: (Show a, Eq a, GenValid a)
    => (b -> a -> a) -> b -> Property
leftIdentityOnValid op b = leftIdentityOnGen op b genValid

-- |
--
-- prop> leftIdentity (flip ((^) :: Int -> Int -> Int)) 1
leftIdentity
    :: (Show a, Eq a, GenUnchecked a)
    => (b -> a -> a) -> b -> Property
leftIdentity op b = leftIdentityOnGen op b genUnchecked

-- |
--
-- prop> leftIdentityOnArbitrary (flip ((^) :: Int -> Int -> Int)) 1
leftIdentityOnArbitrary
    :: (Show a, Eq a, Arbitrary a)
    => (b -> a -> a) -> b -> Property
leftIdentityOnArbitrary op b = leftIdentityOnGen op b arbitrary

-- |
--
-- \[
--   RightIdentity(\star, \doteq, b)
--   \quad\equiv\quad
--   \forall a: (a \star b) \doteq a
-- \]
rightIdentityOnElemWithEquality
    :: (a -> b -> a) -- ^ A binary operation
    -> (a -> a -> Bool) -- ^ An equality
    -> b -- ^ A candidate right-identity
    -> a -- ^ An element
    -> Bool
rightIdentityOnElemWithEquality op eq b a = (a `op` b) `eq` a

rightIdentityOnGenWithEquality
    :: Show a
    => (a -> b -> a) -- ^ A binary operation
    -> (a -> a -> Bool) -- ^ An equality
    -> b -- ^ A candidate right-identity
    -> Gen a
    -> Property
rightIdentityOnGenWithEquality op eq b gen =
    forAll gen $ rightIdentityOnElemWithEquality op eq b

rightIdentityOnGen
    :: (Show a, Eq a)
    => (a -> b -> a) -- ^ A binary operation
    -> b -- ^ A candidate right-identity
    -> Gen a
    -> Property
rightIdentityOnGen op = rightIdentityOnGenWithEquality op (==)

-- |
--
-- prop> rightIdentityOnValid ((^) :: Double -> Int -> Double) 1
rightIdentityOnValid
    :: (Show a, Eq a, GenValid a)
    => (a -> b -> a) -> b -> Property
rightIdentityOnValid op b = rightIdentityOnGen op b genValid

-- |
--
-- prop> rightIdentity ((^) :: Int -> Int -> Int) 1
rightIdentity
    :: (Show a, Eq a, GenUnchecked a)
    => (a -> b -> a) -> b -> Property
rightIdentity op b = rightIdentityOnGen op b genUnchecked

-- |
--
-- prop> rightIdentityOnArbitrary ((^) :: Int -> Int -> Int) 1
rightIdentityOnArbitrary
    :: (Show a, Eq a, Arbitrary a)
    => (a -> b -> a) -> b -> Property
rightIdentityOnArbitrary op b = rightIdentityOnGen op b arbitrary

identityOnGen
    :: (Show a, Eq a)
    => (a -> a -> a) -> a -> Gen a -> Property
identityOnGen op e gen =
    leftIdentityOnGen op e gen .&&. rightIdentityOnGen op e gen

-- |
--
-- prop> identityOnValid ((*) :: Double -> Double -> Double) 1
-- prop> identityOnValid ((+) :: Double -> Double -> Double) 0
identityOnValid
    :: (Show a, Eq a, GenValid a)
    => (a -> a -> a) -> a -> Property
identityOnValid op a = identityOnGen op a genValid

-- |
--
-- prop> identity ((*) :: Int -> Int -> Int) 1
-- prop> identity ((+) :: Int -> Int -> Int) 0
identity
    :: (Show a, Eq a, GenUnchecked a)
    => (a -> a -> a) -> a -> Property
identity op e = identityOnGen op e genUnchecked

-- |
--
-- prop> identityOnArbitrary ((*) :: Int -> Int -> Int) 1
-- prop> identityOnArbitrary ((+) :: Int -> Int -> Int) 0
identityOnArbitrary
    :: (Show a, Eq a, Arbitrary a)
    => (a -> a -> a) -> a -> Property
identityOnArbitrary op a = identityOnGen op a arbitrary