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

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

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Traversable
  (
#if HAVE_UNARY_LAWS
    traversableLaws
#endif
  ) where

import Data.Foldable (foldMap)
import Data.Traversable (Traversable,fmapDefault,foldMapDefault,sequenceA,traverse)
import Test.QuickCheck hiding ((.&.))
#if HAVE_UNARY_LAWS
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
#endif
import Data.Functor.Compose
import Data.Functor.Identity

import qualified Data.Set as S

import Test.QuickCheck.Classes.Internal

#if HAVE_UNARY_LAWS

-- | Tests the following 'Traversable' properties:
--
-- [/Naturality/]
--   @t '.' 'traverse' f ≡ 'traverse' (t '.' f)@
--   for every applicative transformation @t@
-- [/Identity/]
--   @'traverse' 'Identity' ≡ 'Identity'@
-- [/Composition/]
--   @'traverse' ('Compose' '.' 'fmap' g '.' f) ≡ 'Compose' '.' 'fmap' ('traverse' g) '.' 'traverse' f@
-- [/Sequence Naturality/]
--   @t '.' 'sequenceA' ≡ 'sequenceA' '.' 'fmap' t@
--   for every applicative transformation @t@
-- [/Sequence Identity/]
--   @'sequenceA' '.' 'fmap' 'Identity' ≡ 'Identity'@
-- [/Sequence Composition/]
--   @'sequenceA' '.' 'fmap' 'Compose' ≡ 'Compose' '.' 'fmap' 'sequenceA' '.' 'sequenceA'@
-- [/foldMap/]
--   @'foldMap' ≡ 'foldMapDefault'@
-- [/fmap/]
--   @'fmap' ≡ 'fmapDefault'@
--
-- Where an /applicative transformation/ is a function
--
-- @t :: (Applicative f, Applicative g) => f a -> g a@
--
-- preserving the 'Applicative' operations, i.e.
--
-- * Identity: @t ('pure' x) ≡ 'pure' x@
-- * Distributivity: @t (x '<*>' y) ≡ t x '<*>' t y@
traversableLaws ::
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Traversable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Traversable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
traversableLaws :: proxy f -> Laws
traversableLaws = proxy f -> Laws
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Traversable f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Laws
traversableLawsInternal

traversableLawsInternal :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Traversable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Traversable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
traversableLawsInternal :: proxy f -> Laws
traversableLawsInternal proxy f
_ = String -> [(String, Property)] -> Laws
Laws String
"Traversable"
  [ (,) String
"Naturality" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Property) -> Property)
-> (Apply f Integer -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
a :: f Integer)) ->
      Compose (Writer (Set Integer)) Triple (f Integer)
-> Compose (Writer (Set Integer)) Triple (f Integer) -> Property
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a,
 forall x. Show x => Show (f x), forall x. Show x => Show (g x),
 Show a) =>
f (g a) -> f (g a) -> Property
propNestedEq1 (Compose Triple (Writer (Set Integer)) (f Integer)
-> Compose (Writer (Set Integer)) Triple (f Integer)
forall a.
Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans ((Integer -> Compose Triple (Writer (Set Integer)) Integer)
-> f Integer -> Compose Triple (Writer (Set Integer)) (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Integer -> Compose Triple (Writer (Set Integer)) Integer
func4 f Integer
a)) ((Integer -> Compose (Writer (Set Integer)) Triple Integer)
-> f Integer -> Compose (Writer (Set Integer)) Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Compose Triple (Writer (Set Integer)) Integer
-> Compose (Writer (Set Integer)) Triple Integer
forall a.
Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans (Compose Triple (Writer (Set Integer)) Integer
 -> Compose (Writer (Set Integer)) Triple Integer)
-> (Integer -> Compose Triple (Writer (Set Integer)) Integer)
-> Integer
-> Compose (Writer (Set Integer)) Triple Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Compose Triple (Writer (Set Integer)) Integer
func4) f Integer
a)
  , (,) String
"Identity" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      Identity (f Integer) -> Identity (f Integer) -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) =>
f (g a) -> f (g a) -> Bool
nestedEq1 ((Integer -> Identity Integer) -> f Integer -> Identity (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Integer -> Identity Integer
forall a. a -> Identity a
Identity f Integer
t) (f Integer -> Identity (f Integer)
forall a. a -> Identity a
Identity f Integer
t)
  , (,) String
"Composition" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      Compose Triple Triple (f Integer)
-> Compose Triple Triple (f Integer) -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) =>
f (g a) -> f (g a) -> Bool
nestedEq1 ((Integer -> Compose Triple Triple Integer)
-> f Integer -> Compose Triple Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Triple (Triple Integer) -> Compose Triple Triple Integer
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Triple (Triple Integer) -> Compose Triple Triple Integer)
-> (Integer -> Triple (Triple Integer))
-> Integer
-> Compose Triple Triple Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Triple Integer)
-> Triple Integer -> Triple (Triple Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Triple Integer
func5 (Triple Integer -> Triple (Triple Integer))
-> (Integer -> Triple Integer)
-> Integer
-> Triple (Triple Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Triple Integer
func6) f Integer
t) (Triple (Triple (f Integer)) -> Compose Triple Triple (f Integer)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((f Integer -> Triple (f Integer))
-> Triple (f Integer) -> Triple (Triple (f Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Integer -> Triple Integer) -> f Integer -> Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Integer -> Triple Integer
func5) ((Integer -> Triple Integer) -> f Integer -> Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Integer -> Triple Integer
func6 f Integer
t)))
  , (,) String
"Sequence Naturality" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f (Compose Triple ((,) (Set Integer)) Integer) -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((Apply f (Compose Triple ((,) (Set Integer)) Integer) -> Property)
 -> Property)
-> (Apply f (Compose Triple ((,) (Set Integer)) Integer)
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f (Compose Triple ((,) (Set Integer)) Integer)
x :: f (Compose Triple ((,) (S.Set Integer)) Integer))) ->
      let a :: f (Compose Triple (Writer (Set Integer)) Integer)
a = (Compose Triple ((,) (Set Integer)) Integer
 -> Compose Triple (Writer (Set Integer)) Integer)
-> f (Compose Triple ((,) (Set Integer)) Integer)
-> f (Compose Triple (Writer (Set Integer)) Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose Triple ((,) (Set Integer)) Integer
-> Compose Triple (Writer (Set Integer)) Integer
toSpecialApplicative f (Compose Triple ((,) (Set Integer)) Integer)
x in
      Compose (Writer (Set Integer)) Triple (f Integer)
-> Compose (Writer (Set Integer)) Triple (f Integer) -> Property
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a,
 forall x. Show x => Show (f x), forall x. Show x => Show (g x),
 Show a) =>
f (g a) -> f (g a) -> Property
propNestedEq1 (Compose Triple (Writer (Set Integer)) (f Integer)
-> Compose (Writer (Set Integer)) Triple (f Integer)
forall a.
Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans (f (Compose Triple (Writer (Set Integer)) Integer)
-> Compose Triple (Writer (Set Integer)) (f Integer)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA f (Compose Triple (Writer (Set Integer)) Integer)
a)) (f (Compose (Writer (Set Integer)) Triple Integer)
-> Compose (Writer (Set Integer)) Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((Compose Triple (Writer (Set Integer)) Integer
 -> Compose (Writer (Set Integer)) Triple Integer)
-> f (Compose Triple (Writer (Set Integer)) Integer)
-> f (Compose (Writer (Set Integer)) Triple Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose Triple (Writer (Set Integer)) Integer
-> Compose (Writer (Set Integer)) Triple Integer
forall a.
Compose Triple (Writer (Set Integer)) a
-> Compose (Writer (Set Integer)) Triple a
apTrans f (Compose Triple (Writer (Set Integer)) Integer)
a))
  , (,) String
"Sequence Identity" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      Identity (f Integer) -> Identity (f Integer) -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) =>
f (g a) -> f (g a) -> Bool
nestedEq1 (f (Identity Integer) -> Identity (f Integer)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((Integer -> Identity Integer) -> f Integer -> f (Identity Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Identity Integer
forall a. a -> Identity a
Identity f Integer
t)) (f Integer -> Identity (f Integer)
forall a. a -> Identity a
Identity f Integer
t)
  , (,) String
"Sequence Composition" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f (Triple (Triple Integer)) -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f (Triple (Triple Integer)) -> Bool) -> Property)
-> (Apply f (Triple (Triple Integer)) -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f (Triple (Triple Integer))
t :: f (Triple (Triple Integer)))) ->
      Compose Triple Triple (f Integer)
-> Compose Triple Triple (f Integer) -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(forall x. Eq x => Eq (f x), forall x. Eq x => Eq (g x), Eq a) =>
f (g a) -> f (g a) -> Bool
nestedEq1 (f (Compose Triple Triple Integer)
-> Compose Triple Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((Triple (Triple Integer) -> Compose Triple Triple Integer)
-> f (Triple (Triple Integer)) -> f (Compose Triple Triple Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple (Triple Integer) -> Compose Triple Triple Integer
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (Triple (Triple Integer))
t)) (Triple (Triple (f Integer)) -> Compose Triple Triple (f Integer)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((f (Triple Integer) -> Triple (f Integer))
-> Triple (f (Triple Integer)) -> Triple (Triple (f Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Triple Integer) -> Triple (f Integer)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (f (Triple (Triple Integer)) -> Triple (f (Triple Integer))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA f (Triple (Triple Integer))
t)))
  , (,) String
"foldMap" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      (Integer -> Sum Integer) -> f Integer -> Sum Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Integer -> Sum Integer
func3 f Integer
t Sum Integer -> Sum Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Sum Integer) -> f Integer -> Sum Integer
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault Integer -> Sum Integer
func3 f Integer
t
  , (,) String
"fmap" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      f (Sum Integer) -> f (Sum Integer) -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 ((Integer -> Sum Integer) -> f Integer -> f (Sum Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Sum Integer
func3 f Integer
t) ((Integer -> Sum Integer) -> f Integer -> f (Sum Integer)
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault Integer -> Sum Integer
func3 f Integer
t)
  ]


#endif