From 01b448ab8908df069da1cf900f7a0e5759fe2397 Mon Sep 17 00:00:00 2001
From: meooow25 <soumiksarkar.3120@gmail.com>
Date: Sat, 2 Nov 2024 06:52:17 +0530
Subject: [PATCH] Add strictness tests for IntMap construction

---
 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)