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

    module Hedgehog.Classes.Bifoldable (bifoldableLaws, bifoldableFunctorLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common

    import Data.Bifoldable (Bifoldable(..))
    import Data.Bifunctor (Bifunctor(..))
    import Data.Monoid (Endo(..), Sum(..), Product(..))

    -- | Tests the following 'Bifoldable' laws:
    --
    -- [__Identity__]: @'bifold'@ ≡ @'bifoldMap' 'id' 'id'@
    -- [__FoldMap__]: @'bifoldMap' f g@ ≡ @'bifoldr' ('mappend' '.' f) ('mappend' '.' g) 'mempty'@
    -- [__Foldr__]: @'bifoldr' f g z t@ ≡ @'appEndo' ('bifoldMap' ('Endo' '.' f) ('Endo' '.' g) t) z@
    bifoldableLaws :: forall f.
      ( Bifoldable f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    bifoldableLaws :: forall (f :: * -> * -> *).
    (Bifoldable f, forall x y. (Eq x, Eq y) => Eq (f x y),
     forall x y. (Show x, Show y) => Show (f x y)) =>
    (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    bifoldableLaws forall x y. Gen x -> Gen y -> Gen (f x y)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Bifoldable"
      [ (String
    "Identity", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). BifoldableProp f
    bifoldableIdentity Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "FoldMap", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). BifoldableProp f
    bifoldableFoldMap Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "Foldr", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). BifoldableProp f
    bifoldableFoldr GenT Identity x -> GenT Identity y -> GenT Identity (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      ]

    -- | Tests the following 'Bifoldable' / 'Bifunctor' laws:
    --
    -- [__Composition__]: @'bifoldMap' f g@ ≡ @'bifold' '.' 'bimap' f g@
    -- [__FoldMap__]: @'bifoldMap' f g '.' 'bimap' h i@ ≡ @'bifoldMap' (f '.' h) (g '.' i)@
    bifoldableFunctorLaws :: forall f.
      ( Bifoldable f, Bifunctor f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    bifoldableFunctorLaws :: forall (f :: * -> * -> *).
    (Bifoldable f, Bifunctor f, forall x y. (Eq x, Eq y) => Eq (f x y),
     forall x y. (Show x, Show y) => Show (f x y)) =>
    (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Laws
    bifoldableFunctorLaws forall x y. Gen x -> Gen y -> Gen (f x y)
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Bifoldable/Bifunctor"
      [ (String
    "Composition", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). BifoldableFunctorProp f
    bifoldableFunctorComposition Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      , (String
    "FoldMap", (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property
    forall (f :: * -> * -> *). BifoldableFunctorProp f
    bifoldableFunctorFoldMap Gen x -> Gen y -> Gen (f x y)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    gen)
      ]

    type BifoldableProp f =
      ( Bifoldable f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property

    bifoldableIdentity :: forall f. BifoldableProp f
    bifoldableIdentity :: forall (f :: * -> * -> *). BifoldableProp f
    bifoldableIdentity forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f (Sum Integer) (Sum Integer)
    x <- Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f (Sum Integer) (Sum Integer))
     -> PropertyT IO (f (Sum Integer) (Sum Integer)))
    -> Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall a b. (a -> b) -> a -> b
    $ Gen (Sum Integer)
    -> Gen (Sum Integer) -> Gen (f (Sum Integer) (Sum Integer))
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen (Sum Integer)
    genSmallSum Gen (Sum Integer)
    genSmallSum
      let lhs :: Sum Integer
    lhs = f (Sum Integer) (Sum Integer) -> Sum Integer
    forall m. Monoid m => f m m -> m
    forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
    bifold f (Sum Integer) (Sum Integer)
    x
      let rhs :: Sum Integer
    rhs = (Sum Integer -> Sum Integer)
    -> (Sum Integer -> Sum Integer)
    -> f (Sum Integer) (Sum Integer)
    -> Sum Integer
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    forall (p :: * -> * -> *) m a b.
    (Bifoldable p, Monoid m) =>
    (a -> m) -> (b -> m) -> p a b -> m
    bifoldMap Sum Integer -> Sum Integer
    forall a. a -> a
    id Sum Integer -> Sum Integer
    forall a. a -> a
    id f (Sum Integer) (Sum Integer)
    x
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Identity", lawContextLawBody :: String
    lawContextLawBody = String
    "bifold" String -> String -> String
    `congruency` String
    "bifoldMap id id"
            , lawContextTcName :: String
    lawContextTcName = String
    "Bifoldable", lawContextTcProp :: String
    lawContextTcProp =
                 let showX :: String
    showX = f (Sum Integer) (Sum Integer) -> String
    forall a. Show a => a -> String
    show f (Sum Integer) (Sum Integer)
    x;
                 in [String] -> String
    lawWhere
                     [ String
    "bimap id id x" String -> String -> String
    `congruency` String
    "x, where"
                     , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                     ]
            , lawContextReduced :: String
    lawContextReduced = Sum Integer -> Sum Integer -> String
    forall a. Show a => a -> a -> String
    reduced Sum Integer
    lhs Sum Integer
    rhs
            }
      Sum Integer -> Sum Integer -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx Sum Integer
    lhs Sum Integer
    rhs Context
    ctx

    bifoldableFoldMap :: forall f. BifoldableProp f
    bifoldableFoldMap :: forall (f :: * -> * -> *). BifoldableProp f
    bifoldableFoldMap forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f Integer Integer
    x <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      QuadraticEquation
    f' <- Gen QuadraticEquation -> PropertyT IO QuadraticEquation
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen QuadraticEquation
    genQuadraticEquation
      QuadraticEquation
    g' <- Gen QuadraticEquation -> PropertyT IO QuadraticEquation
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen QuadraticEquation
    genQuadraticEquation
      let f :: Integer -> Sum Integer
    f = Integer -> Sum Integer
    forall a. a -> Sum a
    Sum (Integer -> Sum Integer)
    -> (Integer -> Integer) -> Integer -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    f'
      let g :: Integer -> Sum Integer
    g = Integer -> Sum Integer
    forall a. a -> Sum a
    Sum (Integer -> Sum Integer)
    -> (Integer -> Integer) -> Integer -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QuadraticEquation -> Integer -> Integer
    runQuadraticEquation QuadraticEquation
    g'
      let lhs :: Sum Integer
    lhs = ((Integer -> Sum Integer)
    -> (Integer -> Sum Integer) -> f Integer Integer -> Sum Integer
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    forall (p :: * -> * -> *) m a b.
    (Bifoldable p, Monoid m) =>
    (a -> m) -> (b -> m) -> p a b -> m
    bifoldMap Integer -> Sum Integer
    f Integer -> Sum Integer
    g f Integer Integer
    x)
      let rhs :: Sum Integer
    rhs = ((Integer -> Sum Integer -> Sum Integer)
    -> (Integer -> Sum Integer -> Sum Integer)
    -> Sum Integer
    -> f Integer Integer
    -> Sum Integer
    forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> f a b -> c
    forall (p :: * -> * -> *) a c b.
    Bifoldable p =>
    (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
    bifoldr (Sum Integer -> Sum Integer -> Sum Integer
    forall a. Monoid a => a -> a -> a
    mappend (Sum Integer -> Sum Integer -> Sum Integer)
    -> (Integer -> Sum Integer)
    -> Integer
    -> Sum Integer
    -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Sum Integer
    f) (Sum Integer -> Sum Integer -> Sum Integer
    forall a. Monoid a => a -> a -> a
    mappend (Sum Integer -> Sum Integer -> Sum Integer)
    -> (Integer -> Sum Integer)
    -> Integer
    -> Sum Integer
    -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Sum Integer
    g) Sum Integer
    forall a. Monoid a => a
    mempty f Integer Integer
    x)
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "FoldMap", lawContextLawBody :: String
    lawContextLawBody = String
    "bifoldMap f g" String -> String -> String
    `congruency` String
    "bifoldr (mappend . f) (mappend . g) mempty"
            , lawContextTcName :: String
    lawContextTcName = String
    "Bifoldable", lawContextTcProp :: String
    lawContextTcProp =
                 let showX :: String
    showX = f Integer Integer -> String
    forall a. Show a => a -> String
    show f Integer Integer
    x;
                     showF :: String
    showF = QuadraticEquation -> String
    forall a. Show a => a -> String
    show QuadraticEquation
    f';
                     showG :: String
    showG = QuadraticEquation -> String
    forall a. Show a => a -> String
    show QuadraticEquation
    g';
                 in [String] -> String
    lawWhere
                     [ String
    "bifoldMap f g x" String -> String -> String
    `congruency` String
    "bifoldr (mappend . f) (mappend . g) mempty x, where"
                     , String
    "f = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showF
                     , String
    "g = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showG
                     , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                     ]
            , lawContextReduced :: String
    lawContextReduced = Sum Integer -> Sum Integer -> String
    forall a. Show a => a -> a -> String
    reduced Sum Integer
    lhs Sum Integer
    rhs
            }
      Sum Integer -> Sum Integer -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx Sum Integer
    lhs Sum Integer
    rhs Context
    ctx

    bifoldableFoldr :: forall f. BifoldableProp f
    bifoldableFoldr :: forall (f :: * -> * -> *). BifoldableProp f
    bifoldableFoldr forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f Integer Integer
    x <- Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f Integer Integer) -> PropertyT IO (f Integer Integer))
    -> Gen (f Integer Integer) -> PropertyT IO (f Integer Integer)
    forall a b. (a -> b) -> a -> b
    $ Gen Integer -> Gen Integer -> Gen (f Integer Integer)
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen Integer
    genSmallInteger Gen Integer
    genSmallInteger
      LinearEquationTwo
    f' <- Gen LinearEquationTwo -> PropertyT IO LinearEquationTwo
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen LinearEquationTwo
    genLinearEquationTwo
      LinearEquationTwo
    g' <- Gen LinearEquationTwo -> PropertyT IO LinearEquationTwo
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen LinearEquationTwo
    genLinearEquationTwo
      let f :: Integer -> Integer -> Integer
    f = LinearEquationTwo -> Integer -> Integer -> Integer
    runLinearEquationTwo LinearEquationTwo
    f'
      let g :: Integer -> Integer -> Integer
    g = LinearEquationTwo -> Integer -> Integer -> Integer
    runLinearEquationTwo LinearEquationTwo
    g'
      let z0 :: Integer
    z0 = Integer
    0
      let lhs :: Integer
    lhs = ((Integer -> Integer -> Integer)
    -> (Integer -> Integer -> Integer)
    -> Integer
    -> f Integer Integer
    -> Integer
    forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> f a b -> c
    forall (p :: * -> * -> *) a c b.
    Bifoldable p =>
    (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
    bifoldr Integer -> Integer -> Integer
    f Integer -> Integer -> Integer
    g Integer
    z0 f Integer Integer
    x)
      let rhs :: Integer
    rhs = (Endo Integer -> Integer -> Integer
    forall a. Endo a -> a -> a
    appEndo ((Integer -> Endo Integer)
    -> (Integer -> Endo Integer) -> f Integer Integer -> Endo Integer
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    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
    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
    g) f Integer Integer
    x) Integer
    z0)
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Foldr", lawContextLawBody :: String
    lawContextLawBody = String
    "bifoldr f g z t" String -> String -> String
    `congruency` String
    "appEndo (bifoldMap (Endo . f) (Endo . g) t) z"
            , lawContextTcName :: String
    lawContextTcName = String
    "Bifoldable", lawContextTcProp :: String
    lawContextTcProp =
                let showX :: String
    showX = f Integer Integer -> String
    forall a. Show a => a -> String
    show f Integer Integer
    x; showF :: String
    showF = LinearEquationTwo -> String
    forall a. Show a => a -> String
    show LinearEquationTwo
    f'; showG :: String
    showG = LinearEquationTwo -> String
    forall a. Show a => a -> String
    show LinearEquationTwo
    g'; showZ :: String
    showZ = Integer -> String
    forall a. Show a => a -> String
    show Integer
    z0;
                in [String] -> String
    lawWhere
                  [ String
    "bifoldr f g z t" String -> String -> String
    `congruency` String
    "appEndo (bifoldMap (Endo . f) (Endo . g) t z, where"
                  , String
    "f = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showF
                  , String
    "g = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showG
                  , String
    "t = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                  , String
    "z = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showZ
                  ]
            , lawContextReduced :: String
    lawContextReduced = Integer -> Integer -> String
    forall a. Show a => a -> a -> String
    reduced Integer
    lhs Integer
    rhs
            }
      Integer -> Integer -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx Integer
    lhs Integer
    rhs Context
    ctx

    type BifoldableFunctorProp f =
      ( Bifoldable f, Bifunctor f
      , forall x y. (Eq x, Eq y) => Eq (f x y)
      , forall x y. (Show x, Show y) => Show (f x y)
      ) => (forall x y. Gen x -> Gen y -> Gen (f x y)) -> Property

    bifoldableFunctorComposition :: forall f. BifoldableFunctorProp f
    bifoldableFunctorComposition :: forall (f :: * -> * -> *). BifoldableFunctorProp f
    bifoldableFunctorComposition forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f (Sum Integer) (Sum Integer)
    x <- Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f (Sum Integer) (Sum Integer))
     -> PropertyT IO (f (Sum Integer) (Sum Integer)))
    -> Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall a b. (a -> b) -> a -> b
    $ Gen (Sum Integer)
    -> Gen (Sum Integer) -> Gen (f (Sum Integer) (Sum Integer))
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen (Sum Integer)
    genSmallSum Gen (Sum Integer)
    genSmallSum
      let f :: a -> Product a
    f = a -> Product a
    forall a. a -> Product a
    Product; g :: Sum Integer -> Product (Sum Integer)
    g = Sum Integer -> Product (Sum Integer)
    forall a. a -> Product a
    Product (Sum Integer -> Product (Sum Integer))
    -> (Sum Integer -> Sum Integer)
    -> Sum Integer
    -> Product (Sum Integer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Sum Integer -> Sum Integer -> Sum Integer
    forall a. Num a => a -> a -> a
    +Sum Integer
    1)
      let lhs :: Product (Sum Integer)
    lhs = (Sum Integer -> Product (Sum Integer))
    -> (Sum Integer -> Product (Sum Integer))
    -> f (Sum Integer) (Sum Integer)
    -> Product (Sum Integer)
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    forall (p :: * -> * -> *) m a b.
    (Bifoldable p, Monoid m) =>
    (a -> m) -> (b -> m) -> p a b -> m
    bifoldMap Sum Integer -> Product (Sum Integer)
    forall a. a -> Product a
    f Sum Integer -> Product (Sum Integer)
    g f (Sum Integer) (Sum Integer)
    x
      let rhs :: Product (Sum Integer)
    rhs = f (Product (Sum Integer)) (Product (Sum Integer))
    -> Product (Sum Integer)
    forall m. Monoid m => f m m -> m
    forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
    bifold ((Sum Integer -> Product (Sum Integer))
    -> (Sum Integer -> Product (Sum Integer))
    -> f (Sum Integer) (Sum Integer)
    -> f (Product (Sum Integer)) (Product (Sum Integer))
    forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Sum Integer -> Product (Sum Integer)
    forall a. a -> Product a
    f Sum Integer -> Product (Sum Integer)
    g f (Sum Integer) (Sum Integer)
    x)
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Composition", lawContextLawBody :: String
    lawContextLawBody = String
    "bifoldMap f g" String -> String -> String
    `congruency` String
    "bifold . bimap f g"
            , lawContextTcName :: String
    lawContextTcName = String
    "Bifoldable/Bifunctor", lawContextTcProp :: String
    lawContextTcProp =
                let showX :: String
    showX = f (Sum Integer) (Sum Integer) -> String
    forall a. Show a => a -> String
    show f (Sum Integer) (Sum Integer)
    x;
                in [String] -> String
    lawWhere
                  [ String
    "bifoldMap f g x" String -> String -> String
    `congruency` String
    "bifold . bimap f g $ x"
                  , String
    "f = \\x -> Product x"
                  , String
    "g = \\x -> Product (x + 1)"
                  , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                  ]
            , lawContextReduced :: String
    lawContextReduced = Product (Sum Integer) -> Product (Sum Integer) -> String
    forall a. Show a => a -> a -> String
    reduced Product (Sum Integer)
    lhs Product (Sum Integer)
    rhs
            }
      Product (Sum Integer)
    -> Product (Sum Integer) -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx Product (Sum Integer)
    lhs Product (Sum Integer)
    rhs Context
    ctx

    bifoldableFunctorFoldMap :: forall f. BifoldableFunctorProp f
    bifoldableFunctorFoldMap :: forall (f :: * -> * -> *). BifoldableFunctorProp f
    bifoldableFunctorFoldMap forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      f (Sum Integer) (Sum Integer)
    x <- Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen (f (Sum Integer) (Sum Integer))
     -> PropertyT IO (f (Sum Integer) (Sum Integer)))
    -> Gen (f (Sum Integer) (Sum Integer))
    -> PropertyT IO (f (Sum Integer) (Sum Integer))
    forall a b. (a -> b) -> a -> b
    $ Gen (Sum Integer)
    -> Gen (Sum Integer) -> Gen (f (Sum Integer) (Sum Integer))
    forall x y. Gen x -> Gen y -> Gen (f x y)
    fgen Gen (Sum Integer)
    genSmallSum Gen (Sum Integer)
    genSmallSum
      let h :: Sum a -> a
    h (Sum a
    s) = a
    s a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    s a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    3; showH :: String
    showH = String
    "\\(Sum s) -> s * s + 3"
      let i :: Sum a -> a
    i (Sum a
    s) = a
    s a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    s a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    7; showI :: String
    showI = String
    "\\(Sum s) -> s + s - 7"
      let f :: a -> Sum a
    f = a -> Sum a
    forall a. a -> Sum a
    Sum; showF :: String
    showF = String
    "\\x -> Sum x"; g :: Integer -> Sum Integer
    g = Integer -> Sum Integer
    forall a. a -> Sum a
    Sum (Integer -> Sum Integer)
    -> (Integer -> Integer) -> Integer -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1); showG :: String
    showG = String
    "\\x -> Sum (x + 1)"
      let lhs :: Sum Integer
    lhs = (Integer -> Sum Integer)
    -> (Integer -> Sum Integer) -> f Integer Integer -> Sum Integer
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    forall (p :: * -> * -> *) m a b.
    (Bifoldable p, Monoid m) =>
    (a -> m) -> (b -> m) -> p a b -> m
    bifoldMap Integer -> Sum Integer
    forall a. a -> Sum a
    f Integer -> Sum Integer
    g ((Sum Integer -> Integer)
    -> (Sum Integer -> Integer)
    -> f (Sum Integer) (Sum Integer)
    -> f Integer Integer
    forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Sum Integer -> Integer
    forall {a}. Num a => Sum a -> a
    h Sum Integer -> Integer
    forall {a}. Num a => Sum a -> a
    i f (Sum Integer) (Sum Integer)
    x)
      let rhs :: Sum Integer
    rhs = (Sum Integer -> Sum Integer)
    -> (Sum Integer -> Sum Integer)
    -> f (Sum Integer) (Sum Integer)
    -> Sum Integer
    forall m a b. Monoid m => (a -> m) -> (b -> m) -> f a b -> m
    forall (p :: * -> * -> *) m a b.
    (Bifoldable p, Monoid m) =>
    (a -> m) -> (b -> m) -> p a b -> m
    bifoldMap (Integer -> Sum Integer
    forall a. a -> Sum a
    f (Integer -> Sum Integer)
    -> (Sum Integer -> Integer) -> Sum Integer -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Integer -> Integer
    forall {a}. Num a => Sum a -> a
    h) (Integer -> Sum Integer
    g (Integer -> Sum Integer)
    -> (Sum Integer -> Integer) -> Sum Integer -> Sum Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Integer -> Integer
    forall {a}. Num a => Sum a -> a
    i) f (Sum Integer) (Sum Integer)
    x
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "FoldMap", lawContextLawBody :: String
    lawContextLawBody = String
    "bifoldMap f g . bimap h i" String -> String -> String
    `congruency` String
    "bifoldMap (f . h) (g . i)"
            , lawContextTcName :: String
    lawContextTcName = String
    "Bifoldable/Bifunctor", lawContextTcProp :: String
    lawContextTcProp =
                let showX :: String
    showX = f (Sum Integer) (Sum Integer) -> String
    forall a. Show a => a -> String
    show f (Sum Integer) (Sum Integer)
    x;
                in [String] -> String
    lawWhere
                  [ String
    "bifoldMap f g . bimap h i $ x" String -> String -> String
    `congruency` String
    "bifoldMap (f . h) (g . i) $ x, where"
                  , String
    "f = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showF
                  , String
    "g = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showG
                  , String
    "h = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showH
                  , String
    "i = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showI
                  , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                  ]
            , lawContextReduced :: String
    lawContextReduced = Sum Integer -> Sum Integer -> String
    forall a. Show a => a -> a -> String
    reduced Sum Integer
    lhs Sum Integer
    rhs
            }
      Sum Integer -> Sum Integer -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx Sum Integer
    lhs Sum Integer
    rhs Context
    ctx