    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE QuantifiedConstraints #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE LambdaCase #-}

    module Hedgehog.Classes.Traversable (traversableLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common

    import Data.Functor.Identity
    import Data.Functor.Compose
    import Data.Traversable (Traversable(..), foldMapDefault, fmapDefault)

    -- | Tests the following 'Traversable' laws:
    --
    -- [__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@
    -- [__SequenceA Naturality__]: @t '.' 'sequenceA'@ ≡ @'sequenceA' '.' 'fmap' t, for every applicative transformation t@
    -- [__SequenceA Identity__]: @'sequenceA' '.' 'fmap' 'Identity'@ ≡ @'Identity'@
    -- [__SequenceA Composition__]: @'sequenceA' '.' 'fmap' 'Compose'@ ≡ @'Compose' '.' 'fmap' 'sequenceA' '.' 'sequenceA'@
    -- [__FoldMap__]: @'foldMap'@ ≡ @'foldMapDefault'@
    -- [__Fmap__]: @'fmap'@ ≡ @'fmapDefault'@
    traversableLaws ::
      ( Traversable f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Laws
    traversableLaws :: forall (f :: * -> *).
    (Traversable f, forall x. Eq x => Eq (f x),
     forall x. Show x => Show (f x)) =>
    (forall x. Gen x -> Gen (f x)) -> Laws
    traversableLaws forall x. Gen x -> Gen (f x)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Foldable"
      [ (String
    "Naturality", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableNaturality Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Identity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableIdentity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Composition", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableComposition Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Sequence Naturality", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableSequenceNaturality Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Sequence Identity", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableSequenceIdentity Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "Sequence Composition", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableSequenceComposition Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "foldMap", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableFoldMap Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      , (String
    "fmap", (forall x. Gen x -> Gen (f x)) -> Property
    forall (f :: * -> *). TraversableProp f
    traversableFmap Gen x -> Gen (f x)
    forall x. Gen x -> Gen (f x)
    gen)
      ]

    type TraversableProp f =
      ( Traversable f
      , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
      ) => (forall x. Gen x -> Gen (f x)) -> Property

    traversableNaturality :: TraversableProp f
    traversableNaturality :: forall (f :: * -> *). TraversableProp f
    traversableNaturality forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      (apTrans (traverse func4 a)) `heq1` (traverse (apTrans . func4) a)

    traversableIdentity :: TraversableProp f
    traversableIdentity :: forall (f :: * -> *). TraversableProp f
    traversableIdentity forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      t <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      (traverse Identity t) `heq1` (Identity t)

    traversableComposition :: TraversableProp f
    traversableComposition :: forall (f :: * -> *). TraversableProp f
    traversableComposition forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      t <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      let lhs = ((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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> f a -> f (f 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 a b. (a -> b) -> Triple a -> Triple b
    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)
      let rhs = (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 a b. (a -> b) -> Triple a -> Triple b
    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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> f a -> f (f 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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> f a -> f (f b)
    traverse Integer -> Triple Integer
    func6 f Integer
    t)))
      lhs `heq1` rhs

    traversableSequenceNaturality :: TraversableProp f
    traversableSequenceNaturality :: forall (f :: * -> *). TraversableProp f
    traversableSequenceNaturality forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      x <- Gen (f (Compose Triple ((,) (Set Integer)) Integer))
    -> PropertyT IO (f (Compose Triple ((,) (Set Integer)) Integer))
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f (Compose Triple ((,) (Set Integer)) Integer))
     -> PropertyT IO (f (Compose Triple ((,) (Set Integer)) Integer)))
    -> Gen (f (Compose Triple ((,) (Set Integer)) Integer))
    -> PropertyT IO (f (Compose Triple ((,) (Set Integer)) Integer))
    forall a b. (a -> b) -> a -> b
    $ Gen (Compose Triple ((,) (Set Integer)) Integer)
    -> Gen (f (Compose Triple ((,) (Set Integer)) Integer))
    forall x. Gen x -> Gen (f x)
    fgen (Gen Integer
    -> (forall x. Gen x -> Gen (Triple x))
    -> (forall x. Gen x -> Gen (Set Integer, x))
    -> Gen (Compose Triple ((,) (Set Integer)) Integer)
    forall (f :: * -> *) (g :: * -> *) a.
    Gen a
    -> (forall x. Gen x -> Gen (f x))
    -> (forall x. Gen x -> Gen (g x))
    -> Gen (Compose f g a)
    genCompose Gen Integer
    genSmallInteger Gen x -> Gen (Triple x)
    forall x. Gen x -> Gen (Triple x)
    genTriple (Gen (Set Integer)
    -> GenT Identity x -> GenT Identity (Set Integer, x)
    forall a b. Gen a -> Gen b -> Gen (a, b)
    genTuple Gen (Set Integer)
    genSetInteger))
      let 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 a b. (a -> b) -> f a -> f b
    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
      (apTrans (sequenceA a)) `heq1` (sequenceA (fmap apTrans a))

    traversableSequenceIdentity :: TraversableProp f
    traversableSequenceIdentity :: forall (f :: * -> *). TraversableProp f
    traversableSequenceIdentity forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      t <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      (sequenceA (fmap Identity t)) `heq1` (Identity t)

    traversableSequenceComposition :: TraversableProp f
    traversableSequenceComposition :: forall (f :: * -> *). TraversableProp f
    traversableSequenceComposition forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      let genTripleInteger :: Gen (Triple Integer)
    genTripleInteger = Gen Integer -> Gen (Triple Integer)
    forall x. Gen x -> Gen (Triple x)
    genTriple Gen Integer
    genSmallInteger
      t <- Gen (f (Triple (Triple Integer)))
    -> PropertyT IO (f (Triple (Triple Integer)))
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f (Triple (Triple Integer)))
     -> PropertyT IO (f (Triple (Triple Integer))))
    -> Gen (f (Triple (Triple Integer)))
    -> PropertyT IO (f (Triple (Triple Integer)))
    forall a b. (a -> b) -> a -> b
    $ Gen (Triple (Triple Integer)) -> Gen (f (Triple (Triple Integer)))
    forall x. Gen x -> Gen (f x)
    fgen (Gen (Triple Integer) -> Gen (Triple (Triple Integer))
    forall x. Gen x -> Gen (Triple x)
    genTriple Gen (Triple Integer)
    genTripleInteger)
      (sequenceA (fmap Compose t)) `heq1` (Compose (fmap sequenceA (sequenceA t)))

    traversableFoldMap :: TraversableProp f
    traversableFoldMap :: forall (f :: * -> *). TraversableProp f
    traversableFoldMap forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      t <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      foldMap func3 t `heq1` foldMapDefault func3 t

    traversableFmap :: TraversableProp f
    traversableFmap :: forall (f :: * -> *). TraversableProp f
    traversableFmap forall x. Gen x -> Gen (f x)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      t <- Gen (f Integer) -> PropertyT IO (f Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer) -> PropertyT IO (f Integer))
    -> Gen (f Integer) -> PropertyT IO (f Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen (f Integer)
    forall x. Gen x -> Gen (f x)
    fgen Gen Integer
    genSmallInteger
      fmap func3 t `heq1` fmapDefault func3 t