Dear haskellers,

currently the instances are defined as

instance (Monoid a, Monoid b) => Monoid (a,b) where
        mempty = (mempty, mempty)
        (a1,b1) `mappend` (a2,b2) = (a1 `mappend` a2, b1 `mappend` b2)

However for some applications this isn't lazy enough, for example

-- | Build two lists by folding on a pair of `Endo` monoids.
test = head $ appEndo (fst $ foldMap (f &&& f) [1..]) []
  where
    f = Endo . (:)

never terminates because of the unnecessary pattern matching on the constructor (,) forces evaluation of the whole infinite list.

I suggest to change all Monoid instances for tuples to be like

 instance (Monoid a, Monoid b) => Monoid (a,b) where
         mempty = (mempty, mempty)
         ~(a1,b1) `mappend` ~(a2,b2) = (a1 `mappend` a2, b1 `mappend` b2)
--      ^^^                ^^^

which fixes the problem.

Best regards,
Petr