From 30baac7affe7c9d31c0252b669eda804695fb598 Mon Sep 17 00:00:00 2001
From: Tobias Haslop <tobiashaslop@hotmail.de>
Date: Wed, 1 Nov 2023 00:49:26 +0100
Subject: [PATCH] Add laws relating between Foldable/Traversable with their Bi-
 superclasses

See https://github.com/haskell/core-libraries-committee/issues/205 for
discussion.

This commit also documents that the tuple instances only satisfy the
laws up to lazyness, similar to the documentation added in !9512.
---
 libraries/base/src/Data/Bifoldable.hs    | 21 +++++++++++++++++++-
 libraries/base/src/Data/Bifunctor.hs     |  2 +-
 libraries/base/src/Data/Bitraversable.hs | 25 ++++++++++++++++++++----
 3 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/libraries/base/src/Data/Bifoldable.hs b/libraries/base/src/Data/Bifoldable.hs
index 5729695b7291..5676ab2a2a9b 100644
--- a/libraries/base/src/Data/Bifoldable.hs
+++ b/libraries/base/src/Data/Bifoldable.hs
@@ -92,6 +92,15 @@ import GHC.Generics (K1(..))
 -- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z
 -- @
 --
+-- If the type is also an instance of 'Foldable', then
+-- it must satisfy (up to laziness):
+--
+-- @
+-- 'bifoldl' 'const' ≡ 'foldl'
+-- 'bifoldr' ('flip' 'const') ≡ 'foldr'
+-- 'bifoldMap' ('const' 'mempty') ≡ 'foldMap'
+-- @
+--
 -- If the type is also a 'Data.Bifunctor.Bifunctor' instance, it should satisfy:
 --
 -- @
@@ -221,7 +230,17 @@ class Bifoldable p where
   bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)
                                                 (Dual . Endo . flip g) t)) z
 
--- | @since 4.10.0.0
+-- | Class laws for tuples hold only up to laziness. The
+-- Bifoldable methods are lazier than their Foldable counterparts.
+-- For example the law @'bifoldr' ('flip' 'const') ≡ 'foldr'@ does
+-- not hold for tuples if lazyness is exploited:
+--
+-- >>> bifoldr (flip const) (:) [] (undefined :: (Int, Word)) `seq` ()
+-- ()
+-- >>> foldr (:) [] (undefined :: (Int, Word)) `seq` ()
+-- *** Exception: Prelude.undefined
+--
+-- @since 4.10.0.0
 instance Bifoldable (,) where
   bifoldMap f g ~(a, b) = f a `mappend` g b
 
diff --git a/libraries/base/src/Data/Bifunctor.hs b/libraries/base/src/Data/Bifunctor.hs
index 217c4a268121..d01917ffaa75 100644
--- a/libraries/base/src/Data/Bifunctor.hs
+++ b/libraries/base/src/Data/Bifunctor.hs
@@ -44,7 +44,7 @@ import GHC.Generics ( K1(..) )
 -- must be a 'Functor' and the 'second' method must agree with 'fmap'.
 -- From this it follows that:
 --
--- @'second' 'id' = 'id'@
+-- @'second' 'id' ≡ 'id'@
 --
 -- If you supply 'bimap', you should ensure that:
 --
diff --git a/libraries/base/src/Data/Bitraversable.hs b/libraries/base/src/Data/Bitraversable.hs
index f4e3c4297f34..f5d485ce6783 100644
--- a/libraries/base/src/Data/Bitraversable.hs
+++ b/libraries/base/src/Data/Bitraversable.hs
@@ -70,8 +70,8 @@ import GHC.Generics (K1(..))
 -- preserving the 'Applicative' operations:
 --
 -- @
--- t ('pure' x) = 'pure' x
--- t (f '<*>' x) = t f '<*>' t x
+-- t ('pure' x) ≡ 'pure' x
+-- t (f '<*>' x) ≡ t f '<*>' t x
 -- @
 --
 -- and the identity functor 'Identity' and composition functors
@@ -91,11 +91,18 @@ import GHC.Generics (K1(..))
 --
 -- @
 -- 'bimap' f g ≡ 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)
--- 'bifoldMap' f g = 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)
+-- 'bifoldMap' f g ≡ 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)
 -- @
 --
 -- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively.
 --
+-- If the type is also an instance of 'Traversable', then
+-- it must satisfy (up to laziness):
+--
+-- @
+-- 'traverse' ≡ 'bitraverse' 'pure'
+-- @
+--
 -- @since 4.10.0.0
 class (Bifunctor t, Bifoldable t) => Bitraversable t where
   -- | Evaluates the relevant functions at each element in the structure,
@@ -164,7 +171,17 @@ bimapM = bitraverse
 bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
 bisequence = bitraverse id id
 
--- | @since 4.10.0.0
+-- | Class laws for tuples hold only up to laziness. The
+-- Bitraversable methods are lazier than their Traversable counterparts.
+-- For example the law @'bitraverse' 'pure' ≡ 'traverse'@ does
+-- not hold for tuples if lazyness is exploited:
+--
+-- >>> (bitraverse pure pure undefined :: IO (Int, Word)) `seq` ()
+-- ()
+-- >>> (traverse pure undefined :: IO (Int, Word)) `seq` ()
+-- *** Exception: Prelude.undefined
+--
+-- @since 4.10.0.0
 instance Bitraversable (,) where
   bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)
 
-- 
GitLab