{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Bifoldable
  (
#if HAVE_BINARY_LAWS
    bifoldableLaws
  , bifoldableFunctorLaws
#endif
  ) where

#if HAVE_BINARY_LAWS
import Data.Bifoldable(Bifoldable(..))
import Data.Bifunctor (Bifunctor(..))
import Test.QuickCheck hiding ((.&.))
import Data.Functor.Classes (Eq2,Show2)
import Test.QuickCheck.Property (Property)
import Data.Monoid
import Test.QuickCheck.Classes.Internal
#endif

#if HAVE_BINARY_LAWS

-- | Tests the following 'Bifunctor' properties:
--
-- [/Bifold Identity/]
--   @'bifold' ≡ 'bifoldMap' 'id' 'id'@
-- [/BifoldMap Identity/]
--   @'bifoldMap' f g ≡ 'bifoldr' ('mappend' '.' f) ('mappend' '.' g) 'mempty'@
-- [/Bifoldr Identity/]
--   @'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' ('Endo' '.' f) ('Endo' '.' g) t) z@
--
-- /Note/: This property test is only available when this package is built with
-- @base-4.10+@ or @transformers-0.5+@.
bifoldableLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Laws
bifoldableLaws :: proxy f -> Laws
bifoldableLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Bifoldable"
  [ (String
"Bifold Identity", proxy f -> Property
forall (proxy :: (* -> * -> *) -> *) (f :: * -> * -> *).
(Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b),
 forall a b. (Show a, Show b) => Show (f a b),
 forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) =>
proxy f -> Property
bifoldIdentity proxy f
p)
  , (String
"BifoldMap Identity", proxy f -> Property
forall (proxy :: (* -> * -> *) -> *) (f :: * -> * -> *).
(Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b),
 forall a b. (Show a, Show b) => Show (f a b),
 forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) =>
proxy f -> Property
bifoldMapIdentity proxy f
p)
  , (String
"Bifoldr Identity", proxy f -> Property
forall (proxy :: (* -> * -> *) -> *) (f :: * -> * -> *).
(Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b),
 forall a b. (Show a, Show b) => Show (f a b),
 forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) =>
proxy f -> Property
bifoldrIdentity proxy f
p)
  ]

-- | Tests the following 'Bifunctor'/'Bifoldable' properties:
--
-- [/Bifold Identity/]
--   @'bifoldMap' f g ≡ 'bifold' '.' 'bimap' f g@
-- [/BifoldMap Identity/]
--   @'bifoldMap' f g '.' 'bimap' h i ≡ 'bifoldMap' (f '.' h) (g '.' i)@
--
-- /Note/: This property test is only available when this package is built with
-- @base-4.10+@ or @transformers-0.5+@.
bifoldableFunctorLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Laws
bifoldableFunctorLaws :: proxy f -> Laws
bifoldableFunctorLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Bifoldable/Bifunctor"
  [ (String
"Bifoldable Bifunctor Law", proxy f -> Property
forall (proxy :: (* -> * -> *) -> *) (f :: * -> * -> *).
(Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b),
 forall a b. (Show a, Show b) => Show (f a b),
 forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) =>
proxy f -> Property
bifoldableFunctorLaw proxy f
p)
  , (String
"Bifoldable Bifunctor Law Implication", proxy f -> Property
forall (proxy :: (* -> * -> *) -> *) (f :: * -> * -> *).
(Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b),
 forall a b. (Show a, Show b) => Show (f a b),
 forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b)) =>
proxy f -> Property
bifoldableFunctorImplication proxy f
p)
  ]

bifoldableFunctorLaw :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bifoldableFunctorLaw :: proxy f -> Property
bifoldableFunctorLaw proxy f
_ = (Apply2 f Integer Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply2 f Integer Integer -> Bool) -> Property)
-> (Apply2 f Integer Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply2 (f Integer Integer
x :: f Integer Integer)) -> (Integer -> [Integer])
-> (Integer -> [Integer]) -> f Integer Integer -> [Integer]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap Integer -> [Integer]
forall a. a -> [a]
mkMonoid Integer -> [Integer]
forall a. a -> [a]
mkMonoid f Integer Integer
x [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== (f [Integer] [Integer] -> [Integer]
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold ((Integer -> [Integer])
-> (Integer -> [Integer])
-> f Integer Integer
-> f [Integer] [Integer]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> [Integer]
forall a. a -> [a]
mkMonoid Integer -> [Integer]
forall a. a -> [a]
mkMonoid f Integer Integer
x))

bifoldableFunctorImplication :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, Bifunctor f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Bifunctor f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bifoldableFunctorImplication :: proxy f -> Property
bifoldableFunctorImplication proxy f
_ = (Apply2 f Integer Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply2 f Integer Integer -> Bool) -> Property)
-> (Apply2 f Integer Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply2 (f Integer Integer
x :: f Integer Integer)) -> ([Integer] -> [[Integer]])
-> ([Integer] -> [[Integer]])
-> f [Integer] [Integer]
-> [[Integer]]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap [Integer] -> [[Integer]]
forall a. a -> [a]
mkMonoid [Integer] -> [[Integer]]
forall a. a -> [a]
mkMonoid ((Integer -> [Integer])
-> (Integer -> [Integer])
-> f Integer Integer
-> f [Integer] [Integer]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> [Integer]
forall a. a -> [a]
mkMonoid Integer -> [Integer]
forall a. a -> [a]
mkMonoid f Integer Integer
x) [[Integer]] -> [[Integer]] -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> [[Integer]])
-> (Integer -> [[Integer]]) -> f Integer Integer -> [[Integer]]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ([Integer] -> [[Integer]]
forall a. a -> [a]
mkMonoid ([Integer] -> [[Integer]])
-> (Integer -> [Integer]) -> Integer -> [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. a -> [a]
mkMonoid) ([Integer] -> [[Integer]]
forall a. a -> [a]
mkMonoid ([Integer] -> [[Integer]])
-> (Integer -> [Integer]) -> Integer -> [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. a -> [a]
mkMonoid) f Integer Integer
x

bifoldIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bifoldIdentity :: proxy f -> Property
bifoldIdentity proxy f
_ = (Apply2 f [Integer] [Integer] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply2 f [Integer] [Integer] -> Bool) -> Property)
-> (Apply2 f [Integer] [Integer] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply2 (f [Integer] [Integer]
x :: f [Integer] [Integer])) -> (f [Integer] [Integer] -> [Integer]
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold f [Integer] [Integer]
x) [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== (([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> f [Integer] [Integer] -> [Integer]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap [Integer] -> [Integer]
forall a. a -> a
id [Integer] -> [Integer]
forall a. a -> a
id f [Integer] [Integer]
x)

bifoldMapIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bifoldMapIdentity :: proxy f -> Property
bifoldMapIdentity proxy f
_ = (Apply2 f Integer Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply2 f Integer Integer -> Bool) -> Property)
-> (Apply2 f Integer Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply2 (f Integer Integer
x :: f Integer Integer)) -> (Integer -> [Integer])
-> (Integer -> [Integer]) -> f Integer Integer -> [Integer]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap Integer -> [Integer]
forall a. a -> [a]
mkMonoid Integer -> [Integer]
forall a. a -> [a]
mkMonoid f Integer Integer
x [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> [Integer] -> [Integer])
-> (Integer -> [Integer] -> [Integer])
-> [Integer]
-> f Integer Integer
-> [Integer]
forall (p :: * -> * -> *) a c b.
Bifoldable p =>
(a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
bifoldr ([Integer] -> [Integer] -> [Integer]
forall a. Monoid a => a -> a -> a
mappend ([Integer] -> [Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. a -> [a]
mkMonoid) ([Integer] -> [Integer] -> [Integer]
forall a. Monoid a => a -> a -> a
mappend ([Integer] -> [Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. a -> [a]
mkMonoid) [Integer]
forall a. Monoid a => a
mempty f Integer Integer
x

bifoldrIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bifoldable f, forall a b. (Eq a, Eq b) => Eq (f a b), forall a b. (Show a, Show b) => Show (f a b), forall a b. (Arbitrary a, Arbitrary b) => Arbitrary (f a b))
#else
  (Bifoldable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bifoldrIdentity :: proxy f -> Property
bifoldrIdentity proxy f
_ = (Apply2 f Integer Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply2 f Integer Integer -> Bool) -> Property)
-> (Apply2 f Integer Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply2 (f Integer Integer
x :: f Integer Integer)) ->
  let f :: p -> p -> a
f p
_ p
_ = a
forall a. Monoid a => a
mempty
      g :: p -> p -> a
g p
_ p
_ = a
forall a. Monoid a => a
mempty
  in (Integer -> [Integer] -> [Integer])
-> (Integer -> [Integer] -> [Integer])
-> [Integer]
-> f Integer Integer
-> [Integer]
forall (p :: * -> * -> *) a c b.
Bifoldable p =>
(a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
bifoldr Integer -> [Integer] -> [Integer]
forall a p p. Monoid a => p -> p -> a
f Integer -> [Integer] -> [Integer]
forall a p p. Monoid a => p -> p -> a
g ([Integer]
forall a. Monoid a => a
mempty :: [Integer]) f Integer Integer
x [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== Endo [Integer] -> [Integer] -> [Integer]
forall a. Endo a -> a -> a
appEndo ((Integer -> Endo [Integer])
-> (Integer -> Endo [Integer])
-> f Integer Integer
-> Endo [Integer]
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (([Integer] -> [Integer]) -> Endo [Integer]
forall a. (a -> a) -> Endo a
Endo (([Integer] -> [Integer]) -> Endo [Integer])
-> (Integer -> [Integer] -> [Integer]) -> Integer -> Endo [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer] -> [Integer]
forall a p p. Monoid a => p -> p -> a
f) (([Integer] -> [Integer]) -> Endo [Integer]
forall a. (a -> a) -> Endo a
Endo (([Integer] -> [Integer]) -> Endo [Integer])
-> (Integer -> [Integer] -> [Integer]) -> Integer -> Endo [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer] -> [Integer]
forall a p p. Monoid a => p -> p -> a
g) f Integer Integer
x) [Integer]
forall a. Monoid a => a
mempty

mkMonoid :: a -> [a]
mkMonoid :: a -> [a]
mkMonoid a
x = [a
x]
#endif