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

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

    import Data.GenValidity
    import Test.QuickCheck

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

    leftIdentityOnGenWithEquality ::
      Show a =>
      -- | A binary operation
      (b -> a -> a) ->
      -- | An equality
      (a -> a -> Bool) ->
      -- | A candidate left-identity
      b ->
      Gen a ->
      (a -> [a]) ->
      Property
    leftIdentityOnGenWithEquality :: forall a b.
    Show a =>
    (b -> a -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGenWithEquality b -> a -> a
    op a -> a -> Bool
    eq b
    b Gen a
    gen a -> [a]
    s =
      Gen a -> (a -> [a]) -> (a -> Bool) -> Property
    forall a prop.
    (Show a, Testable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrink Gen a
    gen a -> [a]
    s ((a -> Bool) -> Property) -> (a -> Bool) -> Property
    forall a b. (a -> b) -> a -> b
    $ (b -> a -> a) -> (a -> a -> Bool) -> b -> a -> Bool
    forall b a. (b -> a -> a) -> (a -> a -> Bool) -> b -> a -> Bool
    leftIdentityOnElemWithEquality b -> a -> a
    op a -> a -> Bool
    eq b
    b

    leftIdentityOnGen ::
      (Show a, Eq a) =>
      -- | A binary operation
      (b -> a -> a) ->
      -- | A candidate left-identity
      b ->
      Gen a ->
      (a -> [a]) ->
      Property
    leftIdentityOnGen :: forall a b.
    (Show a, Eq a) =>
    (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGen b -> a -> a
    op = (b -> a -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    Show a =>
    (b -> a -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGenWithEquality b -> a -> a
    op a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)

    -- |
    --
    -- prop> leftIdentity (flip ((^) :: Int -> Int -> Int)) 1
    leftIdentity :: (Show a, Eq a, GenValid a) => (b -> a -> a) -> b -> Property
    leftIdentity :: forall a b.
    (Show a, Eq a, GenValid a) =>
    (b -> a -> a) -> b -> Property
    leftIdentity b -> a -> a
    op b
    b = (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGen b -> a -> a
    op b
    b Gen a
    forall a. GenValid a => Gen a
    genValid a -> [a]
    forall a. GenValid a => a -> [a]
    shrinkValid

    -- |
    --
    -- prop> leftIdentityOnArbitrary (flip ((^) :: Int -> Int -> Int)) 1
    leftIdentityOnArbitrary ::
      (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property
    leftIdentityOnArbitrary :: forall a b.
    (Show a, Eq a, Arbitrary a) =>
    (b -> a -> a) -> b -> Property
    leftIdentityOnArbitrary b -> a -> a
    op b
    b = (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGen b -> a -> a
    op b
    b Gen a
    forall a. Arbitrary a => Gen a
    arbitrary a -> [a]
    forall a. Arbitrary a => a -> [a]
    shrink

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

    rightIdentityOnGenWithEquality ::
      Show a =>
      -- | A binary operation
      (a -> b -> a) ->
      -- | An equality
      (a -> a -> Bool) ->
      -- | A candidate right-identity
      b ->
      Gen a ->
      (a -> [a]) ->
      Property
    rightIdentityOnGenWithEquality :: forall a b.
    Show a =>
    (a -> b -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGenWithEquality a -> b -> a
    op a -> a -> Bool
    eq b
    b Gen a
    gen a -> [a]
    s =
      Gen a -> (a -> [a]) -> (a -> Bool) -> Property
    forall a prop.
    (Show a, Testable prop) =>
    Gen a -> (a -> [a]) -> (a -> prop) -> Property
    forAllShrink Gen a
    gen a -> [a]
    s ((a -> Bool) -> Property) -> (a -> Bool) -> Property
    forall a b. (a -> b) -> a -> b
    $ (a -> b -> a) -> (a -> a -> Bool) -> b -> a -> Bool
    forall a b. (a -> b -> a) -> (a -> a -> Bool) -> b -> a -> Bool
    rightIdentityOnElemWithEquality a -> b -> a
    op a -> a -> Bool
    eq b
    b

    rightIdentityOnGen ::
      (Show a, Eq a) =>
      -- | A binary operation
      (a -> b -> a) ->
      -- | A candidate right-identity
      b ->
      Gen a ->
      (a -> [a]) ->
      Property
    rightIdentityOnGen :: forall a b.
    (Show a, Eq a) =>
    (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGen a -> b -> a
    op = (a -> b -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    Show a =>
    (a -> b -> a)
    -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGenWithEquality a -> b -> a
    op a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)

    -- |
    --
    -- prop> rightIdentity ((^) :: Int -> Int -> Int) 1
    rightIdentity ::
      (Show a, Eq a, GenValid a) => (a -> b -> a) -> b -> Property
    rightIdentity :: forall a b.
    (Show a, Eq a, GenValid a) =>
    (a -> b -> a) -> b -> Property
    rightIdentity a -> b -> a
    op b
    b = (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGen a -> b -> a
    op b
    b Gen a
    forall a. GenValid a => Gen a
    genValid a -> [a]
    forall a. GenValid a => a -> [a]
    shrinkValid

    -- |
    --
    -- prop> rightIdentityOnArbitrary ((^) :: Int -> Int -> Int) 1
    rightIdentityOnArbitrary ::
      (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property
    rightIdentityOnArbitrary :: forall a b.
    (Show a, Eq a, Arbitrary a) =>
    (a -> b -> a) -> b -> Property
    rightIdentityOnArbitrary a -> b -> a
    op b
    b = (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGen a -> b -> a
    op b
    b Gen a
    forall a. Arbitrary a => Gen a
    arbitrary a -> [a]
    forall a. Arbitrary a => a -> [a]
    shrink

    -- |
    --
    -- \[
    --   Identity(\star, \doteq, b)
    --   \quad\equiv\quad
    --   LeftIdentity(\star, \doteq, b) \wedge RightIdentity(\star, \doteq, b)
    -- \]
    identityOnGen ::
      (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    identityOnGen :: forall a.
    (Show a, Eq a) =>
    (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    identityOnGen a -> a -> a
    op a
    e Gen a
    gen a -> [a]
    s =
      (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
    leftIdentityOnGen a -> a -> a
    op a
    e Gen a
    gen a -> [a]
    s Property -> Property -> Property
    forall prop1 prop2.
    (Testable prop1, Testable prop2) =>
    prop1 -> prop2 -> Property
    .&&. (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    forall a b.
    (Show a, Eq a) =>
    (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
    rightIdentityOnGen a -> a -> a
    op a
    e Gen a
    gen a -> [a]
    s

    -- |
    --
    -- prop> identity ((*) :: Int -> Int -> Int) 1
    -- prop> identity ((+) :: Int -> Int -> Int) 0
    identity :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> a -> Property
    identity :: forall a.
    (Show a, Eq a, GenValid a) =>
    (a -> a -> a) -> a -> Property
    identity a -> a -> a
    op a
    e = (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    forall a.
    (Show a, Eq a) =>
    (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    identityOnGen a -> a -> a
    op a
    e Gen a
    forall a. GenValid a => Gen a
    genValid a -> [a]
    forall a. GenValid a => a -> [a]
    shrinkValid

    -- |
    --
    -- 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 :: forall a.
    (Show a, Eq a, Arbitrary a) =>
    (a -> a -> a) -> a -> Property
    identityOnArbitrary a -> a -> a
    op a
    a = (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    forall a.
    (Show a, Eq a) =>
    (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
    identityOnGen a -> a -> a
    op a
    a Gen a
    forall a. Arbitrary a => Gen a
    arbitrary a -> [a]
    forall a. Arbitrary a => a -> [a]
    shrink