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

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

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Bitraversable
  (
#if HAVE_BINARY_LAWS
    bitraversableLaws
#endif
  ) where

import Data.Bitraversable(Bitraversable(..))
import Test.QuickCheck hiding ((.&.))
#if HAVE_BINARY_LAWS
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Classes (Eq2,Show2)
#endif
import Test.QuickCheck.Property (Property)

import Test.QuickCheck.Classes.Internal

#if HAVE_BINARY_LAWS

-- | Tests the following 'Bitraversable' properties:
--
-- [/Naturality/]
--   @'bitraverse' (t '.' f) (t '.' g) ≡ t '.' 'bitraverse' f g@ for every applicative transformation @t@
-- [/Identity/]
--   @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@
-- [/Composition/] 
--   @'Compose' '.' 'fmap' ('bitraverse' g1 g2) '.' 'bitraverse' f1 f2 ≡ 'bitraverse' ('Compose' '.' 'fmap' g1 g2 '.' f1) ('Compose' '.' 'fmap' g2 '.' f2)@
--
-- /Note/: This property test is only available when this package is built with
-- @base-4.9+@ or @transformers-0.5+@.
bitraversableLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bitraversable 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
  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Laws
bitraversableLaws p = Laws "Bitraversable"
  [ ("Naturality", bitraversableNaturality p)
  , ("Identity", bitraversableIdentity p)
  , ("Composition", bitraversableComposition p)
  ]

bitraversableNaturality :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bitraversable 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
  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bitraversableNaturality _ = property $ \(Apply2 (x :: f Integer Integer)) ->
  let t = apTrans
      f = func4
      g = func4
      x' = bitraverse (t . f) (t . g) x
      y' = t (bitraverse f g x)
  in eq1_2 x' y'

bitraversableIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bitraversable 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
  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bitraversableIdentity _ = property $ \(Apply2 (x :: f Integer Integer)) -> eq1_2 (bitraverse Identity Identity x) (Identity x)

bitraversableComposition :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Bitraversable 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
  (Bitraversable f, Eq2 f, Show2 f, Arbitrary2 f)
#endif
  => proxy f -> Property
bitraversableComposition _ = property $ \(Apply2 (x :: f Integer Integer)) ->
  let f1 = func6
      f2 = func5
      g1 = func4
      g2 = func4
      x' = Compose . fmap (bitraverse g1 g2) . bitraverse f1 f2 $ x
      y' = bitraverse (Compose . fmap g1 . f1) (Compose . fmap g2 . f2) x
  in eq1_2 x' y'

#endif