From b24068b9a6f75f896b7549923b4321565889dffb Mon Sep 17 00:00:00 2001
From: Soumik Sarkar <soumiksarkar.3120@gmail.com>
Date: Sun, 17 Nov 2024 19:46:38 +0530
Subject: [PATCH] Add strictness tests for IntMap construction (#1063)

This aims to reduce the chance of introducing strictness bugs.
Since we use the same IntMap type for lazy and strict maps, it is not
possible to ensure appropriate strictness at the type level. So we turn
to property tests.

This follows similar tests implemented for Map.
---
 containers-tests/containers-tests.cabal     |    3 +
 containers-tests/tests/Utils/MergeFunc.hs   |   71 ++
 containers-tests/tests/intmap-strictness.hs | 1041 +++++++++++++++++--
 containers-tests/tests/map-strictness.hs    |   76 +-
 4 files changed, 1050 insertions(+), 141 deletions(-)
 create mode 100644 containers-tests/tests/Utils/MergeFunc.hs

diff --git a/containers-tests/containers-tests.cabal b/containers-tests/containers-tests.cabal
index d4adb38cb..e0360b41e 100644
--- a/containers-tests/containers-tests.cabal
+++ b/containers-tests/containers-tests.cabal
@@ -414,6 +414,7 @@ test-suite map-strictness-properties
 
   other-modules:
     Utils.ArbitrarySetMap
+    Utils.MergeFunc
     Utils.Strictness
 
   if impl(ghc >= 8.6)
@@ -439,6 +440,8 @@ test-suite intmap-strictness-properties
 
   other-modules:
     Utils.IsUnit
+    Utils.MergeFunc
+    Utils.Strictness
 
   if impl(ghc >= 8.6)
     build-depends:
diff --git a/containers-tests/tests/Utils/MergeFunc.hs b/containers-tests/tests/Utils/MergeFunc.hs
new file mode 100644
index 000000000..5e6ca9811
--- /dev/null
+++ b/containers-tests/tests/Utils/MergeFunc.hs
@@ -0,0 +1,71 @@
+module Utils.MergeFunc
+  ( WhenMatchedFunc(..)
+  , WhenMissingFunc(..)
+  ) where
+
+import Test.QuickCheck
+import Utils.Strictness (Func, Func2, Func3)
+
+-- k: key, x: left map value, y: right map value, z: result map value,
+-- a,b: fmaps over the result value. a and b are independent variables to allow
+-- for coercions involving Bot. See prop_strictMerge in map-strictness.hs for
+-- an example.
+data WhenMatchedFunc k x y z a b
+  = MaybeMatchedFunc (Func3 k x y (Maybe b))
+  | FmapMaybeMatchedFunc (Func a b) (Func3 k x y (Maybe z))
+  | MatchedFunc (Func3 k x y b)
+  | FmapMatchedFunc (Func a b) (Func3 k x y z)
+  deriving Show
+
+instance
+  ( CoArbitrary k, Function k
+  , CoArbitrary x, Function x
+  , CoArbitrary y, Function y
+  , Arbitrary z
+  , CoArbitrary a, Function a, Arbitrary a
+  , Arbitrary b
+  ) => Arbitrary (WhenMatchedFunc k x y z a b) where
+  arbitrary = oneof
+    [ MaybeMatchedFunc <$> arbitrary
+    , FmapMaybeMatchedFunc <$> arbitrary <*> arbitrary
+    , MatchedFunc <$> arbitrary
+    , FmapMatchedFunc <$> arbitrary <*> arbitrary
+    ]
+  shrink wmf = case wmf of
+    MaybeMatchedFunc fun -> MaybeMatchedFunc <$> shrink fun
+    FmapMaybeMatchedFunc fun2 fun1 ->
+      uncurry FmapMaybeMatchedFunc <$> shrink (fun2, fun1)
+    MatchedFunc fun -> MatchedFunc <$> shrink fun
+    FmapMatchedFunc fun2 fun1 ->
+      uncurry FmapMatchedFunc <$> shrink (fun2, fun1)
+
+-- k: key, x: map value, y: result map value, a,b: fmaps over the result value.
+-- a and b are independent variables to allow for coercions involving Bot. See
+-- prop_strictMerge in map-strictness.hs for an example.
+data WhenMissingFunc k x y a b
+  = MapMaybeMissingFunc (Func2 k x (Maybe b))
+  | FmapMapMaybeMissingFunc (Func a b) (Func2 k x (Maybe y))
+  | MapMissingFunc (Func2 k x b)
+  | FmapMapMissingFunc (Func a b) (Func2 k x y)
+  deriving Show
+
+instance
+  ( CoArbitrary k, Function k
+  , CoArbitrary x, Function x
+  , Arbitrary y
+  , CoArbitrary a, Function a, Arbitrary a
+  , Arbitrary b
+  ) => Arbitrary (WhenMissingFunc k x y a b) where
+  arbitrary = oneof
+    [ MapMaybeMissingFunc <$> arbitrary
+    , FmapMapMaybeMissingFunc <$> arbitrary <*> arbitrary
+    , MapMissingFunc <$> arbitrary
+    , FmapMapMissingFunc <$> arbitrary <*> arbitrary
+    ]
+  shrink wmf = case wmf of
+    MapMaybeMissingFunc fun -> MapMaybeMissingFunc <$> shrink fun
+    FmapMapMaybeMissingFunc fun2 fun1 ->
+      uncurry FmapMapMaybeMissingFunc <$> shrink (fun2, fun1)
+    MapMissingFunc fun -> MapMissingFunc <$> shrink fun
+    FmapMapMissingFunc fun2 fun1 ->
+      uncurry FmapMapMissingFunc <$> shrink (fun2, fun1)
diff --git a/containers-tests/tests/intmap-strictness.hs b/containers-tests/tests/intmap-strictness.hs
index 3c5b65e15..9ec38965b 100644
--- a/containers-tests/tests/intmap-strictness.hs
+++ b/containers-tests/tests/intmap-strictness.hs
@@ -1,29 +1,50 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Main (main) where
 
+import Data.Bifunctor (bimap)
+import Data.Coerce (coerce)
+import Data.Either (partitionEithers)
+import qualified Data.Foldable as F
+import Data.Functor.Identity (Identity(..))
+import Data.Function (on)
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NE
+import Data.Maybe (catMaybes, mapMaybe)
+import Data.Ord (comparing)
 import Test.ChasingBottoms.IsBottom
-import Test.Tasty (TestTree, TestName, defaultMain, testGroup)
-import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck (testProperty, Arbitrary(arbitrary), Fun)
-#if __GLASGOW_HASKELL__ >= 806
-import Test.Tasty.QuickCheck (Property)
-#endif
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+import Test.QuickCheck
+import Test.QuickCheck.Poly (A, B, C)
 import Test.QuickCheck.Function (apply)
 
-import Data.IntMap.Strict (IntMap)
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Data.IntMap.Strict (IntMap, Key)
 import qualified Data.IntMap.Strict as M
 import qualified Data.IntMap as L
+import qualified Data.IntMap.Merge.Strict as MMerge
+import Data.IntMap.Merge.Lazy (WhenMatched, WhenMissing)
+import qualified Data.IntMap.Merge.Lazy as LMerge
 import Data.Containers.ListUtils
 
-import Utils.IsUnit
+import Utils.MergeFunc (WhenMatchedFunc(..), WhenMissingFunc(..))
+import Utils.Strictness
+  (Bot(..), Func, Func2, Func3, applyFunc, applyFunc2, applyFunc3)
 #if __GLASGOW_HASKELL__ >= 806
 import Utils.NoThunks
 #endif
 
 instance Arbitrary v => Arbitrary (IntMap v) where
     arbitrary = M.fromList `fmap` arbitrary
+    shrink = map M.fromList . shrink . M.toList
+
+instance Arbitrary IntSet where
+  arbitrary = IntSet.fromList <$> arbitrary
+  shrink = map IntSet.fromList . shrink . IntSet.toList
 
 apply2 :: Fun (a, b) c -> a -> b -> c
 apply2 f a b = apply f (a, b)
@@ -31,6 +52,758 @@ apply2 f a b = apply f (a, b)
 apply3 :: Fun (a, b, c) d -> a -> b -> c -> d
 apply3 f a b c = apply f (a, b, c)
 
+{--------------------------------------------------------------------
+  Construction property tests
+--------------------------------------------------------------------}
+
+-- See Note [Test overview] in map-strictness.hs
+
+-- See Note [Testing with lazy functions] in map-strictness.hs
+
+prop_strictSingleton :: Key -> Bot A -> Property
+prop_strictSingleton k (Bot x) = isBottom (M.singleton k x) === isBottom x
+
+prop_lazySingleton :: Key -> Bot A -> Property
+prop_lazySingleton k (Bot x) = isNotBottomProp (L.singleton k x)
+
+prop_strictFromSet :: Func Key (Bot A) -> IntSet -> Property
+prop_strictFromSet fun set =
+  isBottom (M.fromSet f set) === any (isBottom . f) (IntSet.toList set)
+  where
+    f = coerce (applyFunc fun) :: Key -> A
+
+prop_lazyFromSet :: Func Key (Bot A) -> IntSet -> Property
+prop_lazyFromSet fun set = isNotBottomProp (L.fromSet f set)
+  where
+    f = coerce (applyFunc fun) :: Key -> A
+
+prop_strictFromList :: [(Key, Bot A)] -> Property
+prop_strictFromList kvs =
+  isBottom (M.fromList kvs') === any (isBottom . snd) kvs'
+  where
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_lazyFromList :: [(Key, Bot A)] -> Property
+prop_lazyFromList kvs = isNotBottomProp (L.fromList kvs')
+  where
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_strictFromListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_strictFromListWith fun kvs =
+  isBottom (M.fromListWith f kvs') ===
+  isBottom (F.foldl' (\acc (k,x) -> M.insertWith f k x acc) M.empty kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_lazyFromListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_lazyFromListWith fun kvs = isNotBottomProp (L.fromListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_strictFromListWithKey
+  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_strictFromListWithKey fun kvs =
+  isBottom (M.fromListWithKey f kvs') ===
+  isBottom (F.foldl' (\acc (k,x) -> M.insertWithKey f k x acc) M.empty kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_lazyFromListWithKey
+  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_lazyFromListWithKey fun kvs = isNotBottomProp (L.fromListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = coerce kvs :: [(Key, A)]
+
+prop_strictFromAscList :: [(Key, Bot A)] -> Property
+prop_strictFromAscList kvs =
+  isBottom (M.fromAscList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_lazyFromAscList :: [(Key, Bot A)] -> Property
+prop_lazyFromAscList kvs = isNotBottomProp (L.fromAscList kvs')
+  where
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_strictFromAscListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_strictFromAscListWith fun kvs =
+  isBottom (M.fromAscListWith f kvs') === isBottom (M.fromListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_lazyFromAscListWith :: Func2 A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_lazyFromAscListWith fun kvs = isNotBottomProp (L.fromAscListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_strictFromAscListWithKey
+  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_strictFromAscListWithKey fun kvs =
+  isBottom (M.fromAscListWithKey f kvs') ===
+  isBottom (M.fromListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_lazyFromAscListWithKey
+  :: Func3 Key A A (Bot A) -> [(Key, Bot A)] -> Property
+prop_lazyFromAscListWithKey fun kvs =
+  isNotBottomProp (L.fromAscListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_strictFromDistinctAscList :: [(Key, Bot A)] -> Property
+prop_strictFromDistinctAscList kvs =
+  isBottom (M.fromDistinctAscList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_lazyFromDistinctAscList :: [(Key, Bot A)] -> Property
+prop_lazyFromDistinctAscList kvs = isNotBottomProp (L.fromDistinctAscList kvs')
+  where
+    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(Key, A)]
+
+prop_strictInsert :: Key -> Bot A -> IntMap A -> Property
+prop_strictInsert k (Bot x) m = isBottom (M.insert k x m) === isBottom x
+
+prop_lazyInsert :: Key -> Bot A -> IntMap A -> Property
+prop_lazyInsert k (Bot x) m = isNotBottomProp (L.insert k x m)
+
+prop_strictInsertWith
+  :: Func2 A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_strictInsertWith fun k (Bot x) m =
+  isBottom (M.insertWith f k x m) === isBottom (M.insertWithKey (const f) k x m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyInsertWith
+  :: Func2 A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_lazyInsertWith fun k (Bot x) m = isNotBottomProp (L.insertWith f k x m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictInsertWithKey
+  :: Func3 Key A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_strictInsertWithKey fun k (Bot x) m =
+  isBottom (M.insertWithKey f k x m) ===
+  isBottom (maybe x (f k x) (M.lookup k m))
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_lazyInsertWithKey
+  :: Func3 Key A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_lazyInsertWithKey fun k (Bot x) m =
+  isNotBottomProp (L.insertWithKey f k x m)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_strictInsertLookupWithKey
+  :: Func3 Key A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_strictInsertLookupWithKey fun k (Bot x) m =
+  isBottom (M.insertLookupWithKey f k x m) ===
+  isBottom (maybe x (f k x) (M.lookup k m))
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_lazyInsertLookupWithKey
+  :: Func3 Key A A (Bot A)
+  -> Key
+  -> Bot A
+  -> IntMap A
+  -> Property
+prop_lazyInsertLookupWithKey fun k (Bot x) m =
+  isNotBottomProp (L.insertLookupWithKey f k x m)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_strictAdjust :: Func A (Bot A) -> Key -> IntMap A -> Property
+prop_strictAdjust fun k m =
+  isBottom (M.adjust f k m) === isBottom (M.alter (fmap f) k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyAdjust :: Func A (Bot A) -> Key -> IntMap A -> Property
+prop_lazyAdjust fun k m = isNotBottomProp (L.adjust f k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictAdjustWithKey
+  :: Func2 Key A (Bot A) -> Key -> IntMap A -> Property
+prop_strictAdjustWithKey fun k m =
+ isBottom (M.adjustWithKey f k m) === isBottom (M.alter (fmap (f k)) k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyAdjustWithKey :: Func2 Key A (Bot A) -> Key -> IntMap A -> Property
+prop_lazyAdjustWithKey fun k m = isNotBottomProp (L.adjustWithKey f k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdate :: Func A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_strictUpdate fun k m =
+  isBottom (M.update f k m) === isBottom (M.alter (>>= f) k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyUpdate :: Func A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_lazyUpdate fun k m = isNotBottomProp (L.update f k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateWithKey
+  :: Func2 Key A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_strictUpdateWithKey fun k m =
+  isBottom (M.updateWithKey f k m) === isBottom (M.alter (>>= f k) k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUpdateWithKey
+  :: Func2 Key A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_lazyUpdateWithKey fun k m = isNotBottomProp (L.updateWithKey f k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdateLookupWithKey
+  :: Func2 Key A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_strictUpdateLookupWithKey fun k m =
+  isBottom (M.updateLookupWithKey f k m) === isBottom (M.updateWithKey f k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUpdateLookupWithKey
+  :: Func2 Key A (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_lazyUpdateLookupWithKey fun k m =
+  isNotBottomProp (L.updateLookupWithKey f k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictAlter
+  :: Func (Maybe A) (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_strictAlter fun k m =
+  isBottom (M.alter f k m) ===
+  maybe False isBottom (f (M.lookup k m))
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyAlter
+  :: Func (Maybe A) (Maybe (Bot A)) -> Key -> IntMap A -> Property
+prop_lazyAlter fun k m = isNotBottomProp (L.alter f k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictAlterF
+  :: Func (Maybe A) (Identity (Maybe (Bot A))) -> Key -> IntMap A -> Property
+prop_strictAlterF fun k m =
+  isBottom (runIdentity (M.alterF f k m)) ===
+  maybe False isBottom (runIdentity (f (M.lookup k m)))
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyAlterF
+  :: Func (Maybe A) (Identity (Maybe (Bot A))) -> Key -> IntMap A -> Property
+prop_lazyAlterF fun k m = isNotBottomProp (runIdentity (L.alterF f k m))
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUnionWith
+  :: Func2 A A (Bot A) -> IntMap A -> IntMap A -> Property
+prop_strictUnionWith fun m1 m2 =
+  isBottom (M.unionWith f m1 m2) ===
+  isBottom (M.unionWithKey (const f) m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUnionWith :: Func2 A A (Bot A) -> IntMap A -> IntMap A -> Property
+prop_lazyUnionWith fun m1 m2 = isNotBottomProp (L.unionWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUnionWithKey
+  :: Func3 Key A A (Bot A) -> IntMap A -> IntMap A -> Property
+prop_strictUnionWithKey fun m1 m2 =
+  isBottom (M.unionWithKey f m1 m2) ===
+  isBottom (M.foldlWithKey' (\acc k x -> M.insertWithKey f k x acc) m2 m1)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_lazyUnionWithKey
+  :: Func3 Key A A (Bot A) -> IntMap A -> IntMap A -> Property
+prop_lazyUnionWithKey fun m1 m2 = isNotBottomProp (L.unionWithKey f m1 m2)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_strictUnionsWith :: Func2 A A (Bot A) -> [IntMap A] -> Property
+prop_strictUnionsWith fun ms =
+  isBottom (M.unionsWith f ms) ===
+  isBottom (F.foldl' (M.unionWith f) M.empty ms)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUnionsWith :: Func2 A A (Bot A) -> [IntMap A] -> Property
+prop_lazyUnionsWith fun ms = isNotBottomProp (L.unionsWith f ms)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictDifferenceWith
+  :: Func2 A B (Maybe (Bot A))
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictDifferenceWith fun m1 m2 =
+  isBottom (M.differenceWith f m1 m2) ===
+  isBottom (M.differenceWithKey (const f) m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyDifferenceWith
+  :: Func2 A B (Maybe (Bot A))
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyDifferenceWith fun m1 m2 = isNotBottomProp (L.differenceWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictDifferenceWithKey
+  :: Func3 Key A B (Maybe (Bot A))
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictDifferenceWithKey fun m1 m2 =
+  isBottom (M.differenceWithKey f m1 m2) ===
+  isBottom
+    (M.foldlWithKey'
+      (\acc k x -> M.updateWithKey (\k' y -> f k' y x) k acc)
+      m1
+      m2)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_lazyDifferenceWithKey
+  :: Func3 Key A B (Maybe (Bot A))
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyDifferenceWithKey fun m1 m2 =
+  isNotBottomProp (L.differenceWithKey f m1 m2)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_strictIntersectionWith
+  :: Func2 A B (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictIntersectionWith fun m1 m2 =
+  isBottom (M.intersectionWith f m1 m2) ===
+  isBottom (M.intersectionWithKey (const f) m1 m2)
+  where
+    f = coerce (applyFunc2 fun) :: A -> B -> C
+
+prop_lazyIntersectionWith
+  :: Func2 A B (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyIntersectionWith fun m1 m2 =
+  isNotBottomProp (L.intersectionWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun) :: A -> B -> C
+
+prop_strictIntersectionWithKey
+  :: Func3 Key A B (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictIntersectionWithKey fun m1 m2 =
+  isBottom (M.intersectionWithKey f m1 m2) ===
+  isBottom
+    (M.foldlWithKey'
+      (\acc k x -> case M.lookup k m2 of
+        Nothing -> acc
+        Just y -> M.insert k (f k x y) acc)
+      M.empty
+      m1)
+  where
+    f = coerce (applyFunc3 fun) :: Key -> A -> B -> C
+
+prop_lazyIntersectionWithKey
+  :: Func3 Key A B (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyIntersectionWithKey fun m1 m2 =
+  isNotBottomProp (L.intersectionWithKey f m1 m2)
+  where
+    f = coerce (applyFunc3 fun) :: Key -> A -> B -> C
+
+prop_strictMergeWithKey
+  :: Func3 Key A B (Maybe (Bot C))
+  -> Fun A (Maybe C)
+  -> Fun B (Maybe C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictMergeWithKey fun12 fun1 fun2 m1 m2 =
+  isBottom (M.mergeWithKey f12 (M.mapMaybe f1) (M.mapMaybe f2) m1 m2) ===
+  any isBottom
+    (mapMaybe (\(k, (x, y)) -> f12 k x y) $
+     M.toList $
+     M.intersectionWith (,) m1 m2)
+  where
+    f12 = coerce (applyFunc3 fun12) :: Key -> A -> B -> Maybe C
+    f1 = applyFun fun1
+    f2 = applyFun fun2
+
+prop_lazyMergeWithKey
+  :: Func3 Key A B (Maybe (Bot C))
+  -> Fun A (Maybe C)
+  -> Fun B (Maybe C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyMergeWithKey fun12 fun1 fun2 m1 m2 =
+  isNotBottomProp (L.mergeWithKey f12 (L.mapMaybe f1) (L.mapMaybe f2) m1 m2)
+  where
+    f12 = coerce (applyFunc3 fun12) :: Key -> A -> B -> Maybe C
+    f1 = applyFun fun1
+    f2 = applyFun fun2
+
+prop_strictMap :: Func A (Bot B) -> IntMap A -> Property
+prop_strictMap fun m =
+  isBottom (M.map f m) === isBottom (M.mapWithKey (const f) m)
+  where
+    f = coerce (applyFunc fun) :: A -> B
+
+prop_lazyMap :: Func A (Bot B) -> IntMap A -> Property
+prop_lazyMap fun m = isNotBottomProp (L.map f m)
+  where
+    f = coerce (applyFunc fun) :: A -> B
+
+prop_strictMapWithKey :: Func2 Key A (Bot B) -> IntMap A -> Property
+prop_strictMapWithKey fun m =
+  isBottom (M.mapWithKey f m) ===
+  any (isBottom . uncurry f) (M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> B
+
+prop_lazyMapWithKey :: Func2 Key A (Bot B) -> IntMap A -> Property
+prop_lazyMapWithKey fun m = isNotBottomProp (L.mapWithKey f m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> B
+
+prop_strictTraverseWithKey
+  :: Func2 Key A (Identity (Bot B)) -> IntMap A -> Property
+prop_strictTraverseWithKey fun m =
+  isBottom (runIdentity (M.traverseWithKey f m)) ===
+  any (isBottom . runIdentity . uncurry f) (M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Identity B
+
+prop_lazyTraverseWithKey
+  :: Func2 Key A (Identity (Bot B)) -> IntMap A -> Property
+prop_lazyTraverseWithKey fun m =
+  isNotBottomProp (runIdentity (L.traverseWithKey f m))
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Identity B
+
+prop_strictTraverseMaybeWithKey
+  :: Func2 Key A (Identity (Maybe (Bot B))) -> IntMap A -> Property
+prop_strictTraverseMaybeWithKey fun m =
+  isBottom (runIdentity (M.traverseMaybeWithKey f m)) ===
+  any (maybe False isBottom . runIdentity . uncurry f) (M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Identity (Maybe B)
+
+prop_lazyTraverseMaybeWithKey
+  :: Func2 Key A (Identity (Maybe (Bot B))) -> IntMap A -> Property
+prop_lazyTraverseMaybeWithKey fun m =
+  isNotBottomProp (runIdentity (L.traverseMaybeWithKey f m))
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Identity (Maybe B)
+
+prop_strictMapAccum :: Func2 A B (A, Bot C) -> A -> IntMap B -> Property
+prop_strictMapAccum fun z m =
+  isBottom (snd (M.mapAccum f z m)) ===
+  isBottom (snd (M.mapAccumWithKey (\acc _ -> f acc) z m))
+  where
+    f = coerce (applyFunc2 fun) :: A -> B -> (A, C)
+
+prop_lazyMapAccum :: Func2 A B (A, Bot C) -> A -> IntMap B -> Property
+prop_lazyMapAccum fun z m = isNotBottomProp (snd (L.mapAccum f z m))
+  where
+    f = coerce (applyFunc2 fun) :: A -> B -> (A, C)
+
+prop_strictMapAccumWithKey
+  :: Func3 A Key B (A, Bot C) -> A -> IntMap B -> Property
+prop_strictMapAccumWithKey fun z m =
+  isBottom (snd (M.mapAccumWithKey f z m)) ===
+  isBottom (M.fromList $ snd $
+    List.mapAccumL (\z' (k, x) -> fmap ((,) k) (f z' k x)) z (M.toList m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> Key -> B -> (A, C)
+
+prop_lazyMapAccumWithKey
+  :: Func3 A Key B (A, Bot C) -> A -> IntMap B -> Property
+prop_lazyMapAccumWithKey fun z m =
+  isNotBottomProp (snd (L.mapAccumWithKey f z m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> Key -> B -> (A, C)
+
+prop_strictMapAccumRWithKey
+  :: Func3 A Key B (A, Bot C) -> A -> IntMap B -> Property
+prop_strictMapAccumRWithKey fun z m =
+  isBottom (snd (M.mapAccumRWithKey f z m)) ===
+  isBottom (M.fromList $ snd $
+    List.mapAccumR (\z' (k, x) -> fmap ((,) k) (f z' k x)) z (M.toList m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> Key -> B -> (A, C)
+
+prop_lazyMapAccumRWithKey
+  :: Func3 A Key B (A, Bot C) -> A -> IntMap B -> Property
+prop_lazyMapAccumRWithKey fun z m =
+  isNotBottomProp (snd (L.mapAccumRWithKey f z m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> Key -> B -> (A, C)
+
+prop_strictMapKeysWith
+  :: Func2 A A (Bot A) -> Func Key Key -> IntMap A -> Property
+prop_strictMapKeysWith fun kfun m =
+  isBottom (M.mapKeysWith f kf m) ===
+  isBottom (M.fromListWith f $ map (\(k, x) -> (kf k, x)) $ M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: A -> A -> A
+    kf = applyFunc kfun
+
+prop_lazyMapKeysWith
+  :: Func2 A A (Bot A) -> Func Key Key -> IntMap A -> Property
+prop_lazyMapKeysWith fun kfun m = isNotBottomProp (L.mapKeysWith f kf m)
+  where
+    f = coerce (applyFunc2 fun) :: A -> A -> A
+    kf = applyFunc kfun
+
+prop_strictMapMaybe :: Func A (Maybe (Bot B)) -> IntMap A -> Property
+prop_strictMapMaybe fun m =
+  isBottom (M.mapMaybe f m) === isBottom (M.mapMaybeWithKey (const f) m)
+  where
+    f = coerce (applyFunc fun) :: A -> Maybe B
+
+prop_lazyMapMaybe :: Func A (Maybe (Bot B)) -> IntMap A -> Property
+prop_lazyMapMaybe fun m = isNotBottomProp (L.mapMaybe f m)
+  where
+    f = coerce (applyFunc fun) :: A -> Maybe B
+
+prop_strictMapMaybeWithKey
+  :: Func2 Key A (Maybe (Bot B)) -> IntMap A -> Property
+prop_strictMapMaybeWithKey fun m =
+  isBottom (M.mapMaybeWithKey f m) ===
+  isBottom (M.fromList $ mapMaybe (\(k, x) -> ((,) k) <$> f k x) $ M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Maybe B
+
+prop_lazyMapMaybeWithKey
+  :: Func2 Key A (Maybe (Bot B)) -> IntMap A -> Property
+prop_lazyMapMaybeWithKey fun m = isNotBottomProp (L.mapMaybeWithKey f m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Maybe B
+
+prop_strictMapEither
+  :: Func A (Either (Bot B) (Bot C)) -> IntMap A -> Property
+prop_strictMapEither fun m =
+  isBottom (M.mapEither f m) ===
+  isBottom (M.mapEitherWithKey (const f) m)
+  where
+    f = coerce (applyFunc fun) :: A -> Either B C
+
+prop_lazyMapEither :: Func A (Either (Bot B) (Bot C)) -> IntMap A -> Property
+prop_lazyMapEither fun m =
+  property $ case L.mapEither f m of
+    (m1, m2) -> not (isBottom m1 || isBottom m2)
+  where
+    f = coerce (applyFunc fun) :: A -> Either B C
+
+prop_strictMapEitherWithKey
+ :: Func2 Key A (Either (Bot B) (Bot C)) -> IntMap A -> Property
+prop_strictMapEitherWithKey fun m =
+  isBottom (M.mapEitherWithKey f m) ===
+  isBottom
+    ((\(!_, !_) -> ()) $ -- Strict in both
+     bimap M.fromList M.fromList $
+     partitionEithers $
+     map (\(k, x) -> bimap ((,) k) ((,) k) (f k x)) $
+     M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Either B C
+
+prop_lazyMapEitherWithKey
+ :: Func2 Key A (Either (Bot B) (Bot C)) -> IntMap A -> Property
+prop_lazyMapEitherWithKey fun m =
+  property $ case L.mapEitherWithKey f m of
+    (m1, m2) -> not (isBottom m1 || isBottom m2)
+  where
+    f = coerce (applyFunc2 fun) :: Key -> A -> Either B C
+
+prop_strictUpdateMin :: Func A (Bot A) -> IntMap A -> Property
+prop_strictUpdateMin fun m =
+  isBottom (M.updateMin (Just . f) m) ===
+  isBottom (M.updateMinWithKey (const (Just . f)) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyUpdateMin :: Func A (Bot A) -> IntMap A -> Property
+prop_lazyUpdateMin fun m = isNotBottomProp (L.updateMin (Just . f) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateMinWithKey :: Func2 Key A (Bot A) -> IntMap A -> Property
+prop_strictUpdateMinWithKey fun m =
+  isBottom (M.updateMinWithKey (\k x -> Just (f k x)) m) ===
+  maybe False (isBottom . uncurry f) (M.lookupMin m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUpdateMinWithKey :: Func2 Key A (Bot A) -> IntMap A -> Property
+prop_lazyUpdateMinWithKey fun m =
+  isNotBottomProp (L.updateMinWithKey (\k x -> Just (f k x)) m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdateMax :: Func A (Bot A) -> IntMap A -> Property
+prop_strictUpdateMax fun m =
+  isBottom (M.updateMax (Just . f) m) ===
+  isBottom (M.updateMaxWithKey (const (Just . f)) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_lazyUpdateMax :: Func A (Bot A) -> IntMap A -> Property
+prop_lazyUpdateMax fun m = isNotBottomProp (L.updateMax (Just . f) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateMaxWithKey :: Func2 Key A (Bot A) -> IntMap A -> Property
+prop_strictUpdateMaxWithKey fun m =
+  isBottom (M.updateMaxWithKey (\k x -> Just (f k x)) m) ===
+  maybe False (isBottom . uncurry f) (M.lookupMax m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUpdateMaxWithKey :: Func2 Key A (Bot A) -> IntMap A -> Property
+prop_lazyUpdateMaxWithKey fun m =
+  isNotBottomProp (L.updateMaxWithKey (\k x -> Just (f k x)) m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictMerge
+  :: WhenMissingFunc Key A (Bot C) C (Bot C)
+  -> WhenMissingFunc Key B (Bot C) C (Bot C)
+  -> WhenMatchedFunc Key A B (Bot C) C (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictMerge misfun1 misfun2 matfun m1 m2 =
+  isBottom (MMerge.merge mis1 mis2 mat m1 m2) ===
+  any isBottom
+    (catMaybes $ concat
+      [ map (\(k, (x, y)) -> matf k x y) $
+        M.toList $
+        M.intersectionWith (,) m1 m2
+      , map (uncurry misf1) $ M.toList $ M.difference m1 m2
+      , map (uncurry misf2) $ M.toList $ M.difference m2 m1
+      ])
+  where
+    misfun1' = coerce misfun1 :: WhenMissingFunc Key A C C C
+    misfun2' = coerce misfun2 :: WhenMissingFunc Key B C C C
+    matfun' = coerce matfun :: WhenMatchedFunc Key A B C C C
+    mis1 = toStrictWhenMissing misfun1'
+    mis2 = toStrictWhenMissing misfun2'
+    mat = toStrictWhenMatched matfun'
+    misf1 = whenMissingApplyStrict misfun1'
+    misf2 = whenMissingApplyStrict misfun2'
+    matf = whenMatchedApplyStrict  matfun'
+
+prop_lazyMerge
+  :: WhenMissingFunc Key A (Bot C) C (Bot C)
+  -> WhenMissingFunc Key B (Bot C) C (Bot C)
+  -> WhenMatchedFunc Key A B (Bot C) C (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyMerge misfun1 misfun2 matfun m1 m2 =
+  isNotBottomProp (MMerge.merge mis1 mis2 mat m1 m2)
+  where
+    mis1 = toLazyWhenMissing (coerce misfun1 :: WhenMissingFunc Key A C C C)
+    mis2 = toLazyWhenMissing (coerce misfun2 :: WhenMissingFunc Key B C C C)
+    mat = toLazyWhenMatched (coerce matfun :: WhenMatchedFunc Key A B C C C)
+
+prop_strictMergeA
+  :: WhenMissingFunc Key A (Bot C) C (Bot C)
+  -> WhenMissingFunc Key B (Bot C) C (Bot C)
+  -> WhenMatchedFunc Key A B (Bot C) C (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_strictMergeA misfun1 misfun2 matfun m1 m2 =
+  isBottom (runIdentity (MMerge.mergeA mis1 mis2 mat m1 m2)) ===
+  any isBottom
+    (catMaybes $ concat
+      [ map (\(k, (x, y)) -> matf k x y) $
+        M.toList $
+        M.intersectionWith (,) m1 m2
+      , map (uncurry misf1) $ M.toList $ M.difference m1 m2
+      , map (uncurry misf2) $ M.toList $ M.difference m2 m1
+      ])
+  where
+    misfun1' = coerce misfun1 :: WhenMissingFunc Key A C C C
+    misfun2' = coerce misfun2 :: WhenMissingFunc Key B C C C
+    matfun' = coerce matfun :: WhenMatchedFunc Key A B C C C
+    mis1 = toStrictWhenMissingA misfun1'
+    mis2 = toStrictWhenMissingA misfun2'
+    mat = toStrictWhenMatchedA matfun'
+    misf1 = whenMissingApplyStrict misfun1'
+    misf2 = whenMissingApplyStrict misfun2'
+    matf = whenMatchedApplyStrict  matfun'
+
+prop_lazyMergeA
+  :: WhenMissingFunc Key A (Bot C) C (Bot C)
+  -> WhenMissingFunc Key B (Bot C) C (Bot C)
+  -> WhenMatchedFunc Key A B (Bot C) C (Bot C)
+  -> IntMap A
+  -> IntMap B
+  -> Property
+prop_lazyMergeA misfun1 misfun2 matfun m1 m2 =
+  isNotBottomProp (runIdentity (LMerge.mergeA mis1 mis2 mat m1 m2))
+  where
+    mis1 = toLazyWhenMissingA (coerce misfun1 :: WhenMissingFunc Key A C C C)
+    mis2 = toLazyWhenMissingA (coerce misfun2 :: WhenMissingFunc Key B C C C)
+    mat = toLazyWhenMatchedA (coerce matfun :: WhenMatchedFunc Key A B C C C)
+
 ------------------------------------------------------------------------
 -- * Properties
 
@@ -116,67 +889,6 @@ pStrictFoldl' :: IntMap Int -> Property
 pStrictFoldl' m = whnfHasNoThunks (M.foldl' (flip (:)) [] m)
 #endif
 
-#if __GLASGOW_HASKELL__ >= 806
-pStrictFromDistinctAscList :: [Int] -> Property
-pStrictFromDistinctAscList = whnfHasNoThunks . evalSpine . M.elems . M.fromDistinctAscList . zip [0::Int ..] . map (Just $!)
-  where
-    evalSpine xs = length xs `seq` xs
-#endif
-
-------------------------------------------------------------------------
--- check for extra thunks
---
--- These tests distinguish between `()`, a fully evaluated value, and
--- things like `id ()` which are extra thunks that should be avoided
--- in most cases. An exception is `L.fromListWith const`, which cannot
--- evaluate the `const` calls.
-
-tExtraThunksM :: TestTree
-tExtraThunksM = testGroup "IntMap.Strict - extra thunks" $
-    if not isUnitSupported then [] else
-    -- for strict maps, all the values should be evaluated to ()
-    [ check "singleton"           $ m0
-    , check "insert"              $ M.insert 42 () m0
-    , check "insertWith"          $ M.insertWith const 42 () m0
-    , check "fromList"            $ M.fromList [(42,()),(42,())]
-    , check "fromListWith"        $ M.fromListWith const [(42,()),(42,())]
-    , check "fromAscList"         $ M.fromAscList [(42,()),(42,())]
-    , check "fromAscListWith"     $ M.fromAscListWith const [(42,()),(42,())]
-    , check "fromDistinctAscList" $ M.fromAscList [(42,())]
-    ]
-  where
-    m0 = M.singleton 42 ()
-    check :: TestName -> IntMap () -> TestTree
-    check n m = testCase n $ case M.lookup 42 m of
-        Just v -> assertBool msg (isUnit v)
-        _      -> assertBool "key not found" False
-      where
-        msg = "too lazy -- expected fully evaluated ()"
-
-tExtraThunksL :: TestTree
-tExtraThunksL = testGroup "IntMap.Lazy - extra thunks" $
-    if not isUnitSupported then [] else
-    -- for lazy maps, the *With functions should leave `const () ()` thunks,
-    -- but the other functions should produce fully evaluated ().
-    [ check "singleton"       True  $ m0
-    , check "insert"          True  $ L.insert 42 () m0
-    , check "insertWith"      False $ L.insertWith const 42 () m0
-    , check "fromList"        True  $ L.fromList [(42,()),(42,())]
-    , check "fromListWith"    False $ L.fromListWith const [(42,()),(42,())]
-    , check "fromAscList"     True  $ L.fromAscList [(42,()),(42,())]
-    , check "fromAscListWith" False $ L.fromAscListWith const [(42,()),(42,())]
-    , check "fromDistinctAscList" True $ L.fromAscList [(42,())]
-    ]
-  where
-    m0 = L.singleton 42 ()
-    check :: TestName -> Bool -> L.IntMap () -> TestTree
-    check n e m = testCase n $ case L.lookup 42 m of
-        Just v -> assertBool msg (e == isUnit v)
-        _      -> assertBool "key not found" False
-      where
-        msg | e         = "too lazy -- expected fully evaluated ()"
-            | otherwise = "too strict -- expected a thunk"
-
 ------------------------------------------------------------------------
 -- * Test list
 
@@ -209,13 +921,65 @@ tests =
 #if __GLASGOW_HASKELL__ >= 806
       , testProperty "strict foldr'" pStrictFoldr'
       , testProperty "strict foldl'" pStrictFoldl'
-      , testProperty "strict fromDistinctAscList" pStrictFromDistinctAscList
 #endif
       ]
-      , tExtraThunksM
-      , tExtraThunksL
+    , testGroup "Construction"
+      [ testPropStrictLazy "singleton" prop_strictSingleton prop_lazySingleton
+      , testPropStrictLazy "fromSet" prop_strictFromSet prop_lazyFromSet
+      , testPropStrictLazy "fromList" prop_strictFromList prop_lazyFromList
+      , testPropStrictLazy "fromListWith" prop_strictFromListWith prop_lazyFromListWith
+      , testPropStrictLazy "fromListWithKey" prop_strictFromListWithKey prop_lazyFromListWithKey
+      , testPropStrictLazy "fromAscList" prop_strictFromAscList prop_lazyFromAscList
+      , testPropStrictLazy "fromAscListWith" prop_strictFromAscListWith prop_lazyFromAscListWith
+      , testPropStrictLazy "fromAscListWithKey" prop_strictFromAscListWithKey prop_lazyFromAscListWithKey
+      , testPropStrictLazy "fromDistinctAscList" prop_strictFromDistinctAscList prop_lazyFromDistinctAscList
+      , testPropStrictLazy "insert" prop_strictInsert prop_lazyInsert
+      , testPropStrictLazy "insertWith" prop_strictInsertWith prop_lazyInsertWith
+      , testPropStrictLazy "insertWithKey" prop_strictInsertWithKey prop_lazyInsertWithKey
+      , testPropStrictLazy "insertLookupWithKey" prop_strictInsertLookupWithKey prop_lazyInsertLookupWithKey
+      , testPropStrictLazy "adjust" prop_strictAdjust prop_lazyAdjust
+      , testPropStrictLazy "adjustWithKey" prop_strictAdjustWithKey prop_lazyAdjustWithKey
+      , testPropStrictLazy "update" prop_strictUpdate prop_lazyUpdate
+      , testPropStrictLazy "updateWithKey" prop_strictUpdateWithKey prop_lazyUpdateWithKey
+      , testPropStrictLazy "updateLookupWithKey" prop_strictUpdateLookupWithKey prop_lazyUpdateLookupWithKey
+      , testPropStrictLazy "alter" prop_strictAlter prop_lazyAlter
+      , testPropStrictLazy "alterF" prop_strictAlterF prop_lazyAlterF
+      , testPropStrictLazy "unionWith" prop_strictUnionWith prop_lazyUnionWith
+      , testPropStrictLazy "unionWithKey" prop_strictUnionWithKey prop_lazyUnionWithKey
+      , testPropStrictLazy "unionsWith" prop_strictUnionsWith prop_lazyUnionsWith
+      , testPropStrictLazy "differenceWith" prop_strictDifferenceWith prop_lazyDifferenceWith
+      , testPropStrictLazy "differenceWithKey" prop_strictDifferenceWithKey prop_lazyDifferenceWithKey
+      , testPropStrictLazy "intersectionWith" prop_strictIntersectionWith prop_lazyIntersectionWith
+      , testPropStrictLazy "intersectionWithKey" prop_strictIntersectionWithKey prop_lazyIntersectionWithKey
+      , testPropStrictLazy "mergeWithKey" prop_strictMergeWithKey prop_lazyMergeWithKey
+      , testPropStrictLazy "map" prop_strictMap prop_lazyMap
+      , testPropStrictLazy "mapWithKey" prop_strictMapWithKey prop_lazyMapWithKey
+      , testPropStrictLazy "traverseWithKey" prop_strictTraverseWithKey prop_lazyTraverseWithKey
+      , testPropStrictLazy "traverseMaybeWithKey" prop_strictTraverseMaybeWithKey prop_lazyTraverseMaybeWithKey
+      , testPropStrictLazy "mapAccum" prop_strictMapAccum prop_lazyMapAccum
+      , testPropStrictLazy "mapAccumWithKey" prop_strictMapAccumWithKey prop_lazyMapAccumWithKey
+      , testPropStrictLazy "mapAccumRWithKey" prop_strictMapAccumRWithKey prop_lazyMapAccumRWithKey
+      , testPropStrictLazy "mapKeysWith" prop_strictMapKeysWith prop_lazyMapKeysWith
+      , testPropStrictLazy "mapMaybe" prop_strictMapMaybe prop_lazyMapMaybe
+      , testPropStrictLazy "mapMaybeWithKey" prop_strictMapMaybeWithKey prop_lazyMapMaybeWithKey
+      , testPropStrictLazy "mapEither" prop_strictMapEither prop_lazyMapEither
+      , testPropStrictLazy "mapEitherWithKey" prop_strictMapEitherWithKey prop_lazyMapEitherWithKey
+      , testPropStrictLazy "updateMin" prop_strictUpdateMin prop_lazyUpdateMin
+      , testPropStrictLazy "updateMinWithKey" prop_strictUpdateMinWithKey prop_lazyUpdateMinWithKey
+      , testPropStrictLazy "updateMax" prop_strictUpdateMax prop_lazyUpdateMax
+      , testPropStrictLazy "updateMaxWithKey" prop_strictUpdateMaxWithKey prop_lazyUpdateMaxWithKey
+      , testPropStrictLazy "merge" prop_strictMerge prop_lazyMerge
+      , testPropStrictLazy "mergeA" prop_strictMergeA prop_lazyMergeA
+      ]
     ]
 
+testPropStrictLazy :: Testable a => String -> a -> a -> TestTree
+testPropStrictLazy name strictTest lazyTest =
+  testGroup name
+  [ testProperty "strict" strictTest
+  , testProperty "lazy" lazyTest
+  ]
+
 ------------------------------------------------------------------------
 -- * Test harness
 
@@ -228,8 +992,141 @@ main = defaultMain $ testGroup "intmap-strictness" tests
 keyStrict :: (Int -> IntMap Int -> a) -> IntMap Int -> Bool
 keyStrict f m = isBottom $ f bottom m
 
+isNotBottomProp :: a -> Property
+isNotBottomProp = property . not . isBottom
+
 const2 :: a -> b -> c -> a
 const2 x _ _ = x
 
 const3 :: a -> b -> c -> d -> a
 const3 x _ _ _ = x
+
+-- | Keep the first of adjacent equal elements.
+uniqOn :: Eq b => (a -> b) -> [a] -> [a]
+uniqOn f = map NE.head . NE.groupBy ((==) `on` f)
+
+{--------------------------------------------------------------------
+  Merge stuff
+--------------------------------------------------------------------}
+
+toStrictWhenMatched
+  :: WhenMatchedFunc Key x y z z z2 -> WhenMatched Identity x y z2
+toStrictWhenMatched wmf = case wmf of
+  MaybeMatchedFunc fun -> MMerge.zipWithMaybeMatched (applyFunc3 fun)
+  FmapMaybeMatchedFunc fun2 fun1 ->
+    MMerge.mapWhenMatched (applyFunc fun2) $
+    MMerge.zipWithMaybeMatched (applyFunc3 fun1)
+  MatchedFunc fun -> MMerge.zipWithMatched (applyFunc3 fun)
+  FmapMatchedFunc fun2 fun1 ->
+    MMerge.mapWhenMatched (applyFunc fun2) $
+    MMerge.zipWithMatched (applyFunc3 fun1)
+
+toStrictWhenMatchedA
+  :: WhenMatchedFunc Key x y z z z2 -> WhenMatched Identity x y z2
+toStrictWhenMatchedA wmf = case wmf of
+  MaybeMatchedFunc fun -> MMerge.zipWithMaybeAMatched (coerce (applyFunc3 fun))
+  FmapMaybeMatchedFunc fun2 fun1 ->
+    MMerge.mapWhenMatched (applyFunc fun2) $
+    MMerge.zipWithMaybeAMatched (coerce (applyFunc3 fun1))
+  MatchedFunc fun -> MMerge.zipWithAMatched (coerce (applyFunc3 fun))
+  FmapMatchedFunc fun2 fun1 ->
+    MMerge.mapWhenMatched (applyFunc fun2) $
+    MMerge.zipWithAMatched (coerce (applyFunc3 fun1))
+
+toLazyWhenMatched
+  :: WhenMatchedFunc Key x y z z z2 -> WhenMatched Identity x y z2
+toLazyWhenMatched wmf = case wmf of
+  MaybeMatchedFunc fun -> LMerge.zipWithMaybeMatched (applyFunc3 fun)
+  FmapMaybeMatchedFunc fun2 fun1 ->
+    LMerge.mapWhenMatched (applyFunc fun2) $
+    LMerge.zipWithMaybeMatched (applyFunc3 fun1)
+  MatchedFunc fun -> LMerge.zipWithMatched (applyFunc3 fun)
+  FmapMatchedFunc fun2 fun1 ->
+    LMerge.mapWhenMatched (applyFunc fun2) $
+    LMerge.zipWithMatched (applyFunc3 fun1)
+
+toLazyWhenMatchedA
+  :: WhenMatchedFunc Key x y z z z2 -> WhenMatched Identity x y z2
+toLazyWhenMatchedA wmf = case wmf of
+  MaybeMatchedFunc fun -> LMerge.zipWithMaybeAMatched (coerce (applyFunc3 fun))
+  FmapMaybeMatchedFunc fun2 fun1 ->
+    LMerge.mapWhenMatched (applyFunc fun2) $
+    LMerge.zipWithMaybeAMatched (coerce (applyFunc3 fun1))
+  MatchedFunc fun -> LMerge.zipWithAMatched (coerce (applyFunc3 fun))
+  FmapMatchedFunc fun2 fun1 ->
+    LMerge.mapWhenMatched (applyFunc fun2) $
+    LMerge.zipWithAMatched (coerce (applyFunc3 fun1))
+
+whenMatchedApplyStrict
+  :: WhenMatchedFunc Key x y z z z2 -> Key -> x -> y -> Maybe z2
+whenMatchedApplyStrict wmf = case wmf of
+  MaybeMatchedFunc fun -> applyFunc3 fun
+  FmapMaybeMatchedFunc fun2 fun1 ->
+    \k x y ->
+      (applyFunc fun2 $!) <$> -- Strict in the intermediate result
+      applyFunc3 fun1 k x y
+  MatchedFunc fun -> \k x y -> Just (applyFunc3 fun k x y)
+  FmapMatchedFunc fun2 fun1 ->
+    \k x y -> Just $
+      applyFunc fun2 $! -- Strict in the intermediate result
+      applyFunc3 fun1 k x y
+
+toStrictWhenMissing :: WhenMissingFunc Key x y y y2 -> WhenMissing Identity x y2
+toStrictWhenMissing wmf = case wmf of
+  MapMaybeMissingFunc fun -> MMerge.mapMaybeMissing (applyFunc2 fun)
+  FmapMapMaybeMissingFunc fun2 fun1 ->
+    MMerge.mapWhenMissing (applyFunc fun2) $
+    MMerge.mapMaybeMissing (applyFunc2 fun1)
+  MapMissingFunc fun -> MMerge.mapMissing (applyFunc2 fun)
+  FmapMapMissingFunc fun2 fun1 ->
+    MMerge.mapWhenMissing (applyFunc fun2) $
+    MMerge.mapMissing (applyFunc2 fun1)
+
+toStrictWhenMissingA
+  :: WhenMissingFunc Key x y y y2 -> WhenMissing Identity x y2
+toStrictWhenMissingA wmf = case wmf of
+  MapMaybeMissingFunc fun ->
+    MMerge.traverseMaybeMissing (coerce (applyFunc2 fun))
+  FmapMapMaybeMissingFunc fun2 fun1 ->
+    MMerge.mapWhenMissing (applyFunc fun2) $
+    MMerge.traverseMaybeMissing (coerce (applyFunc2 fun1))
+  MapMissingFunc fun -> MMerge.traverseMissing (coerce (applyFunc2 fun))
+  FmapMapMissingFunc fun2 fun1 ->
+    MMerge.mapWhenMissing (applyFunc fun2) $
+    MMerge.traverseMissing (coerce (applyFunc2 fun1))
+
+toLazyWhenMissing :: WhenMissingFunc Key x y y y2 -> WhenMissing Identity x y2
+toLazyWhenMissing wmf = case wmf of
+  MapMaybeMissingFunc fun -> LMerge.mapMaybeMissing (applyFunc2 fun)
+  FmapMapMaybeMissingFunc fun2 fun1 ->
+    LMerge.mapWhenMissing (applyFunc fun2) $
+    LMerge.mapMaybeMissing (applyFunc2 fun1)
+  MapMissingFunc fun -> LMerge.mapMissing (applyFunc2 fun)
+  FmapMapMissingFunc fun2 fun1 ->
+    LMerge.mapWhenMissing (applyFunc fun2) $
+    LMerge.mapMissing (applyFunc2 fun1)
+
+toLazyWhenMissingA :: WhenMissingFunc Key x y y y2 -> WhenMissing Identity x y2
+toLazyWhenMissingA wmf = case wmf of
+  MapMaybeMissingFunc fun ->
+    LMerge.traverseMaybeMissing (coerce (applyFunc2 fun))
+  FmapMapMaybeMissingFunc fun2 fun1 ->
+    LMerge.mapWhenMissing (applyFunc fun2) $
+    LMerge.traverseMaybeMissing (coerce (applyFunc2 fun1))
+  MapMissingFunc fun -> LMerge.traverseMissing (coerce (applyFunc2 fun))
+  FmapMapMissingFunc fun2 fun1 ->
+    LMerge.mapWhenMissing (applyFunc fun2) $
+    LMerge.traverseMissing (coerce (applyFunc2 fun1))
+
+whenMissingApplyStrict :: WhenMissingFunc Key x y y y2 -> Key -> x -> Maybe y2
+whenMissingApplyStrict wmf = case wmf of
+  MapMaybeMissingFunc fun -> applyFunc2 fun
+  FmapMapMaybeMissingFunc fun2 fun1 ->
+    \k x ->
+      (applyFunc fun2 $!) <$> -- Strict in the intermediate result
+      applyFunc2 fun1 k x
+  MapMissingFunc fun -> \k x -> Just (applyFunc2 fun k x)
+  FmapMapMissingFunc fun2 fun1 ->
+    \k x -> Just $
+      applyFunc fun2 $! -- Strict in the intermediate result
+      applyFunc2 fun1 k x
diff --git a/containers-tests/tests/map-strictness.hs b/containers-tests/tests/map-strictness.hs
index 697720e69..f69f1b3f4 100644
--- a/containers-tests/tests/map-strictness.hs
+++ b/containers-tests/tests/map-strictness.hs
@@ -33,6 +33,7 @@ import qualified Data.Set as Set
 import Data.Containers.ListUtils (nubOrd)
 
 import Utils.ArbitrarySetMap (setFromList, mapFromKeysList)
+import Utils.MergeFunc (WhenMatchedFunc(..), WhenMissingFunc(..))
 import Utils.Strictness
   (Bot(..), Func, Func2, Func3, applyFunc, applyFunc2, applyFunc3)
 
@@ -836,14 +837,14 @@ prop_lazyUpdateMin fun m = isNotBottomProp (L.updateMin (Just . f) m)
     f = coerce (applyFunc fun)
 
 prop_strictUpdateMinWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
-prop_strictUpdateMinWithKey fun m = not (M.null m) ==>
+prop_strictUpdateMinWithKey fun m =
   isBottom (M.updateMinWithKey (\k x -> Just (f k x)) m) ===
-  isBottom (uncurry f (M.findMin m))
+  maybe False (isBottom . uncurry f) (M.lookupMin m)
   where
     f = coerce (applyFunc2 fun)
 
 prop_lazyUpdateMinWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
-prop_lazyUpdateMinWithKey fun m = not (L.null m) ==>
+prop_lazyUpdateMinWithKey fun m =
   isNotBottomProp (L.updateMinWithKey (\k x -> Just (f k x)) m)
   where
     f = coerce (applyFunc2 fun)
@@ -861,14 +862,14 @@ prop_lazyUpdateMax fun m = isNotBottomProp (L.updateMax (Just . f) m)
     f = coerce (applyFunc fun)
 
 prop_strictUpdateMaxWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
-prop_strictUpdateMaxWithKey fun m = not (M.null m) ==>
+prop_strictUpdateMaxWithKey fun m =
   isBottom (M.updateMaxWithKey (\k x -> Just (f k x)) m) ===
-  isBottom (uncurry f (M.findMax m))
+  maybe False (isBottom . uncurry f) (M.lookupMax m)
   where
     f = coerce (applyFunc2 fun)
 
 prop_lazyUpdateMaxWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
-prop_lazyUpdateMaxWithKey fun m = not (M.null m) ==>
+prop_lazyUpdateMaxWithKey fun m =
   isNotBottomProp (L.updateMaxWithKey (\k x -> Just (f k x)) m)
   where
     f = coerce (applyFunc2 fun)
@@ -1155,38 +1156,6 @@ uniqOn f = map NE.head . NE.groupBy ((==) `on` f)
   Merge stuff
 --------------------------------------------------------------------}
 
--- k: key, x: left map value, y: right map value, z: result map value,
--- a,b: fmaps over the result value. a and b are independent variables to allow
--- for coercions involving Bot. See prop_strictMerge for an example.
-data WhenMatchedFunc k x y z a b
-  = MaybeMatchedFunc (Func3 k x y (Maybe b))
-  | FmapMaybeMatchedFunc (Func a b) (Func3 k x y (Maybe z))
-  | MatchedFunc (Func3 k x y b)
-  | FmapMatchedFunc (Func a b) (Func3 k x y z)
-  deriving Show
-
-instance
-  ( CoArbitrary k, Function k
-  , CoArbitrary x, Function x
-  , CoArbitrary y, Function y
-  , Arbitrary z
-  , CoArbitrary a, Function a, Arbitrary a
-  , Arbitrary b
-  ) => Arbitrary (WhenMatchedFunc k x y z a b) where
-  arbitrary = oneof
-    [ MaybeMatchedFunc <$> arbitrary
-    , FmapMaybeMatchedFunc <$> arbitrary <*> arbitrary
-    , MatchedFunc <$> arbitrary
-    , FmapMatchedFunc <$> arbitrary <*> arbitrary
-    ]
-  shrink wmf = case wmf of
-    MaybeMatchedFunc fun -> MaybeMatchedFunc <$> shrink fun
-    FmapMaybeMatchedFunc fun2 fun1 ->
-      uncurry FmapMaybeMatchedFunc <$> shrink (fun2, fun1)
-    MatchedFunc fun -> MatchedFunc <$> shrink fun
-    FmapMatchedFunc fun2 fun1 ->
-      uncurry FmapMatchedFunc <$> shrink (fun2, fun1)
-
 toStrictWhenMatched
   :: WhenMatchedFunc k x y z z z2 -> WhenMatched Identity k x y z2
 toStrictWhenMatched wmf = case wmf of
@@ -1249,37 +1218,6 @@ whenMatchedApplyStrict wmf = case wmf of
       applyFunc fun2 $! -- Strict in the intermediate result
       applyFunc3 fun1 k x y
 
--- k: key, x: map value, y: result map value, a,b: fmaps over the result value.
--- a and b are independent variables to allow for coercions involving Bot. See
--- prop_strictMerge for an example.
-data WhenMissingFunc k x y a b
-  = MapMaybeMissingFunc (Func2 k x (Maybe b))
-  | FmapMapMaybeMissingFunc (Func a b) (Func2 k x (Maybe a))
-  | MapMissingFunc (Func2 k x b)
-  | FmapMapMissingFunc (Func a b) (Func2 k x a)
-  deriving Show
-
-instance
-  ( CoArbitrary k, Function k
-  , CoArbitrary x, Function x
-  , Arbitrary y
-  , CoArbitrary a, Function a, Arbitrary a
-  , Arbitrary b
-  ) => Arbitrary (WhenMissingFunc k x y a b) where
-  arbitrary = oneof
-    [ MapMaybeMissingFunc <$> arbitrary
-    , FmapMapMaybeMissingFunc <$> arbitrary <*> arbitrary
-    , MapMissingFunc <$> arbitrary
-    , FmapMapMissingFunc <$> arbitrary <*> arbitrary
-    ]
-  shrink wmf = case wmf of
-    MapMaybeMissingFunc fun -> MapMaybeMissingFunc <$> shrink fun
-    FmapMapMaybeMissingFunc fun2 fun1 ->
-      uncurry FmapMapMaybeMissingFunc <$> shrink (fun2, fun1)
-    MapMissingFunc fun -> MapMissingFunc <$> shrink fun
-    FmapMapMissingFunc fun2 fun1 ->
-      uncurry FmapMapMissingFunc <$> shrink (fun2, fun1)
-
 toStrictWhenMissing :: WhenMissingFunc k x y y y2 -> WhenMissing Identity k x y2
 toStrictWhenMissing wmf = case wmf of
   MapMaybeMissingFunc fun -> MMerge.mapMaybeMissing (applyFunc2 fun)