diff --git a/containers-tests/containers-tests.cabal b/containers-tests/containers-tests.cabal
index da7c76a0f..d4adb38cb 100644
--- a/containers-tests/containers-tests.cabal
+++ b/containers-tests/containers-tests.cabal
@@ -270,6 +270,9 @@ test-suite map-lazy-properties
   main-is:          map-properties.hs
   type:             exitcode-stdio-1.0
 
+  other-modules:
+    Utils.ArbitrarySetMap
+
   ghc-options:      -O2
   other-extensions:
     BangPatterns
@@ -283,6 +286,9 @@ test-suite map-strict-properties
   type:             exitcode-stdio-1.0
   cpp-options:      -DSTRICT
 
+  other-modules:
+    Utils.ArbitrarySetMap
+
   ghc-options:      -O2
   other-extensions:
     BangPatterns
@@ -306,6 +312,9 @@ test-suite set-properties
   main-is:          set-properties.hs
   type:             exitcode-stdio-1.0
 
+  other-modules:
+    Utils.ArbitrarySetMap
+
   ghc-options:      -O2
   other-extensions:
     BangPatterns
@@ -404,7 +413,8 @@ test-suite map-strictness-properties
     CPP
 
   other-modules:
-    Utils.IsUnit
+    Utils.ArbitrarySetMap
+    Utils.Strictness
 
   if impl(ghc >= 8.6)
     build-depends:
diff --git a/containers-tests/tests/Utils/ArbitrarySetMap.hs b/containers-tests/tests/Utils/ArbitrarySetMap.hs
new file mode 100644
index 000000000..4a0409ec6
--- /dev/null
+++ b/containers-tests/tests/Utils/ArbitrarySetMap.hs
@@ -0,0 +1,117 @@
+module Utils.ArbitrarySetMap
+  (
+    -- MonadGen
+    MonadGen(..)
+
+    -- Set
+  , mkArbSet
+  , setFromList
+
+    -- Map
+  , mkArbMap
+  , mapFromKeysList
+  ) where
+
+import Control.Monad (liftM, liftM3, liftM4)
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Class
+import qualified Data.List as List
+import Data.Maybe (fromMaybe)
+import Test.QuickCheck
+
+import Data.Set (Set)
+import qualified Data.Set.Internal as S
+import Data.Map (Map)
+import qualified Data.Map.Internal as M
+
+{--------------------------------------------------------------------
+  MonadGen
+--------------------------------------------------------------------}
+
+class Monad m => MonadGen m where
+  liftGen :: Gen a -> m a
+instance MonadGen Gen where
+  liftGen = id
+instance MonadGen m => MonadGen (StateT s m) where
+  liftGen = lift . liftGen
+
+{--------------------------------------------------------------------
+  Set
+--------------------------------------------------------------------}
+
+-- | Given an action that produces successively larger elements and
+-- a size, produce a set of arbitrary shape with exactly that size.
+mkArbSet :: MonadGen m => m a -> Int -> m (Set a)
+mkArbSet step n
+  | n <= 0 = return S.Tip
+  | n == 1 = S.singleton `liftM` step
+  | n == 2 = do
+     dir <- liftGen arbitrary
+     p <- step
+     q <- step
+     if dir
+       then return (S.Bin 2 q (S.singleton p) S.Tip)
+       else return (S.Bin 2 p S.Tip (S.singleton q))
+  | otherwise = do
+      -- This assumes a balance factor of delta = 3
+      let upper = (3*(n - 1)) `quot` 4
+      let lower = (n + 2) `quot` 4
+      ln <- liftGen $ choose (lower, upper)
+      let rn = n - ln - 1
+      liftM3
+        (\lt x rt -> S.Bin n x lt rt)
+        (mkArbSet step ln)
+        step
+        (mkArbSet step rn)
+{-# INLINABLE mkArbSet #-}
+
+-- | Given a strictly increasing list of elements, produce an arbitrarily
+-- shaped set with exactly those elements.
+setFromList :: [a] -> Gen (Set a)
+setFromList xs = flip evalStateT xs $ mkArbSet step (length xs)
+  where
+    step = state $ fromMaybe (error "setFromList") . List.uncons
+
+{--------------------------------------------------------------------
+  Map
+--------------------------------------------------------------------}
+
+-- | Given an action that produces successively larger keys and
+-- a size, produce a map of arbitrary shape with exactly that size.
+mkArbMap :: (MonadGen m, Arbitrary v) => m k -> Int -> m (Map k v)
+mkArbMap step n
+  | n <= 0 = return M.Tip
+  | n == 1 = do
+     k <- step
+     v <- liftGen arbitrary
+     return (M.singleton k v)
+  | n == 2 = do
+     dir <- liftGen arbitrary
+     p <- step
+     q <- step
+     vOuter <- liftGen arbitrary
+     vInner <- liftGen arbitrary
+     if dir
+       then return (M.Bin 2 q vOuter (M.singleton p vInner) M.Tip)
+       else return (M.Bin 2 p vOuter M.Tip (M.singleton q vInner))
+  | otherwise = do
+      -- This assumes a balance factor of delta = 3
+      let upper = (3*(n - 1)) `quot` 4
+      let lower = (n + 2) `quot` 4
+      ln <- liftGen $ choose (lower, upper)
+      let rn = n - ln - 1
+      liftM4
+        (\lt x v rt -> M.Bin n x v lt rt)
+        (mkArbMap step ln)
+        step
+        (liftGen arbitrary)
+        (mkArbMap step rn)
+{-# INLINABLE mkArbMap #-}
+
+-- | Given a strictly increasing list of keys, produce an arbitrarily
+-- shaped map with exactly those keys.
+mapFromKeysList :: Arbitrary a => [k] -> Gen (Map k a)
+mapFromKeysList xs = flip evalStateT xs $ mkArbMap step (length xs)
+  where
+    step = state $ fromMaybe (error "mapFromKeysList") . List.uncons
+{-# INLINABLE mapFromKeysList #-}
diff --git a/containers-tests/tests/Utils/Strictness.hs b/containers-tests/tests/Utils/Strictness.hs
new file mode 100644
index 000000000..755745170
--- /dev/null
+++ b/containers-tests/tests/Utils/Strictness.hs
@@ -0,0 +1,116 @@
+module Utils.Strictness
+  ( Bot(..)
+  , Func
+  , applyFunc
+  , Func2
+  , applyFunc2
+  , Func3
+  , applyFunc3
+  ) where
+
+import Test.ChasingBottoms.IsBottom (isBottom)
+import Test.QuickCheck
+
+{--------------------------------------------------------------------
+  Bottom stuff
+--------------------------------------------------------------------}
+
+-- | Arbitrary (Bot a) values may be bottom.
+newtype Bot a = Bot a
+
+instance Show a => Show (Bot a) where
+  show (Bot x) = if isBottom x then "<bottom>" else show x
+
+instance Arbitrary a => Arbitrary (Bot a) where
+  arbitrary = frequency
+    [ (1, pure (error "<bottom>"))
+    , (4, Bot <$> arbitrary)
+    ]
+
+{--------------------------------------------------------------------
+  Lazy functions
+--------------------------------------------------------------------}
+
+-- | A function which may be lazy in its argument.
+--
+-- Either ignores its argument, or uses a QuickCheck Fun (which is always a
+-- strict function).
+data Func a b
+  = FuncLazy b
+  | FuncStrict (Fun a b)
+
+instance (Show a, Show b) => Show (Func a b) where
+  show (FuncLazy x) = "{_lazy->" ++ show x ++ "}"
+  show (FuncStrict fun) = show fun
+
+applyFunc :: Func a b -> a -> b
+applyFunc fun x = case fun of
+  FuncLazy y -> y
+  FuncStrict f -> applyFun f x
+
+instance (CoArbitrary a, Function a, Arbitrary b) => Arbitrary (Func a b) where
+  arbitrary = frequency
+    [ (1, FuncLazy <$> arbitrary)
+    , (4, FuncStrict <$> arbitrary)
+    ]
+
+  shrink fun = case fun of
+    FuncLazy x -> FuncLazy <$> shrink x
+    FuncStrict f -> FuncStrict <$> shrink f
+
+-- | A function which may be lazy in its arguments.
+
+-- Note: We have two separate cases here because we want to generate functions
+-- of type `a -> b -> c` with all possible strictness configurations.
+-- `Func a (Func b c)` is not enough for this, since it cannot generate
+-- functions that are conditionally lazy in the first argument, for instance:
+--
+-- leftLazyOr :: Bool -> Bool -> Bool
+-- leftLazyOr a b = if b then True else a
+
+data Func2 a b c
+  = F2A (Func a (Func b c))
+  | F2B (Func b (Func a c))
+  deriving Show
+
+instance
+  (CoArbitrary a, Function a, CoArbitrary b, Function b, Arbitrary c)
+  => Arbitrary (Func2 a b c) where
+  arbitrary = oneof [F2A <$> arbitrary, F2B <$> arbitrary]
+
+  shrink fun2 = case fun2 of
+    F2A fun -> F2A <$> shrink fun
+    F2B fun -> F2B <$> shrink fun
+
+applyFunc2 :: Func2 a b c -> a -> b -> c
+applyFunc2 fun2 x y = case fun2 of
+  F2A fun -> applyFunc (applyFunc fun x) y
+  F2B fun -> applyFunc (applyFunc fun y) x
+
+-- | A function which may be lazy in its arguments.
+
+-- See Note on Func2.
+data Func3 a b c d
+  = F3A (Func a (Func2 b c d))
+  | F3B (Func b (Func2 a c d))
+  | F3C (Func c (Func2 a b d))
+  deriving Show
+
+instance
+  ( CoArbitrary a, Function a
+  , CoArbitrary b, Function b
+  , CoArbitrary c, Function c
+  , Arbitrary d
+  ) => Arbitrary (Func3 a b c d) where
+  arbitrary = oneof [F3A <$> arbitrary, F3B <$> arbitrary, F3C <$> arbitrary]
+
+  shrink fun3 = case fun3 of
+    F3A fun -> F3A <$> shrink fun
+    F3B fun -> F3B <$> shrink fun
+    F3C fun -> F3C <$> shrink fun
+
+applyFunc3 :: Func3 a b c d -> a -> b -> c -> d
+applyFunc3 fun3 x y z = case fun3 of
+  F3A fun -> applyFunc2 (applyFunc fun x) y z
+  F3B fun -> applyFunc2 (applyFunc fun y) x z
+  F3C fun -> applyFunc2 (applyFunc fun z) x y
diff --git a/containers-tests/tests/map-properties.hs b/containers-tests/tests/map-properties.hs
index 1a6d4d58b..f265b432a 100644
--- a/containers-tests/tests/map-properties.hs
+++ b/containers-tests/tests/map-properties.hs
@@ -7,13 +7,13 @@ import Data.Map.Merge.Strict
 import Data.Map.Lazy as Data.Map
 import Data.Map.Merge.Lazy
 #endif
-import Data.Map.Internal (Map (..), link2, link, bin)
+import Data.Map.Internal (Map, link2, link)
 import Data.Map.Internal.Debug (showTree, showTreeWith, balanced)
 
 import Control.Applicative (Const(Const, getConst), pure, (<$>), (<*>))
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Trans.Class
-import Control.Monad (liftM4, (<=<))
+import Control.Monad ((<=<))
 import Data.Functor.Identity (Identity(Identity, runIdentity))
 import Data.Monoid
 import Data.Maybe hiding (mapMaybe)
@@ -36,7 +36,8 @@ import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
 import Test.QuickCheck.Function (apply)
 import Test.QuickCheck.Poly (A, B, OrdA)
-import Control.Arrow (first)
+
+import Utils.ArbitrarySetMap (mkArbMap)
 
 default (Int)
 
@@ -305,7 +306,7 @@ instance (IsInt k, Arbitrary v) => Arbitrary (Map k v) where
         middle <- choose (-positionFactor * (sz + 1), positionFactor * (sz + 1))
         let shift = (sz * (gapRange) + 1) `quot` 2
             start = middle - shift
-        t <- evalStateT (mkArb step sz) start
+        t <- evalStateT (mkArbMap step sz) start
         if valid t then pure t else error "Test generated invalid tree!")
     where
       step = do
@@ -315,39 +316,6 @@ instance (IsInt k, Arbitrary v) => Arbitrary (Map k v) where
         put i'
         pure (fromInt i')
 
-class Monad m => MonadGen m where
-  liftGen :: Gen a -> m a
-instance MonadGen Gen where
-  liftGen = id
-instance MonadGen m => MonadGen (StateT s m) where
-  liftGen = lift . liftGen
-
--- | Given an action that produces successively larger keys and
--- a size, produce a map of arbitrary shape with exactly that size.
-mkArb :: (MonadGen m, Arbitrary v) => m k -> Int -> m (Map k v)
-mkArb step n
-  | n <= 0 = return Tip
-  | n == 1 = do
-     k <- step
-     v <- liftGen arbitrary
-     return (singleton k v)
-  | n == 2 = do
-     dir <- liftGen arbitrary
-     p <- step
-     q <- step
-     vOuter <- liftGen arbitrary
-     vInner <- liftGen arbitrary
-     if dir
-       then return (Bin 2 q vOuter (singleton p vInner) Tip)
-       else return (Bin 2 p vOuter Tip (singleton q vInner))
-  | otherwise = do
-      -- This assumes a balance factor of delta = 3
-      let upper = (3*(n - 1)) `quot` 4
-      let lower = (n + 2) `quot` 4
-      ln <- liftGen $ choose (lower, upper)
-      let rn = n - ln - 1
-      liftM4 (\lt x v rt -> Bin n x v lt rt) (mkArb step ln) step (liftGen arbitrary) (mkArb step rn)
-
 -- A type with a peculiar Eq instance designed to make sure keys
 -- come from where they're supposed to.
 data OddEq a = OddEq a Bool deriving (Show)
diff --git a/containers-tests/tests/map-strictness.hs b/containers-tests/tests/map-strictness.hs
index fa9a0f221..697720e69 100644
--- a/containers-tests/tests/map-strictness.hs
+++ b/containers-tests/tests/map-strictness.hs
@@ -4,27 +4,57 @@
 
 module Main (main) where
 
-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.QuickCheck.Function (apply)
+import Data.Bifunctor (bimap)
+import Data.Coerce (coerce)
+import Data.Either (partitionEithers)
+import Data.Foldable as F
+import Data.Function (on)
+import Data.Functor.Identity (Identity(..))
+import qualified Data.List as List
+import qualified Data.List.NonEmpty as NE
+import Data.Ord (Down(..), comparing)
+import Data.Maybe (catMaybes, mapMaybe)
+import Data.Semigroup (Arg(..))
+import Test.ChasingBottoms.IsBottom (bottom, isBottom)
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+import Test.QuickCheck
+import Test.QuickCheck.Function
+import Test.QuickCheck.Poly (A, B, C, OrdA, OrdB)
 
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import qualified Data.Map.Merge.Strict as MMerge
 import qualified Data.Map as L
+import Data.Map.Merge.Lazy (WhenMatched, WhenMissing)
+import qualified Data.Map.Merge.Lazy as LMerge
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Containers.ListUtils (nubOrd)
+
+import Utils.ArbitrarySetMap (setFromList, mapFromKeysList)
+import Utils.Strictness
+  (Bot(..), Func, Func2, Func3, applyFunc, applyFunc2, applyFunc3)
 
-import Utils.IsUnit
 #if __GLASGOW_HASKELL__ >= 806
 import Utils.NoThunks
 #endif
 
 instance (Arbitrary k, Arbitrary v, Ord k) =>
          Arbitrary (Map k v) where
-    arbitrary = M.fromList `fmap` arbitrary
+  arbitrary = do
+    Sorted xs <- arbitrary
+    m <- mapFromKeysList (nubOrd xs)
+
+    -- Force the values to WHNF. Should use liftRnf2 when that's available.
+    let !_ = foldr seq () m
+
+    pure m
+
+instance (Arbitrary a, Ord a) => Arbitrary (Set a) where
+  arbitrary = do
+    Sorted xs <- arbitrary
+    setFromList (nubOrd xs)
 
 apply2 :: Fun (a, b) c -> a -> b -> c
 apply2 f a b = apply f (a, b)
@@ -32,8 +62,900 @@ 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)
 
-------------------------------------------------------------------------
--- * Properties
+{--------------------------------------------------------------------
+  Construction property tests
+--------------------------------------------------------------------}
+
+-- Note [Test overview]
+-- ~~~~~~~~~~~~~~~~~~~~
+--
+-- The purpose of these property tests is to ensure that
+--
+-- 1. Functions in Data.Map.Strict force values (as in key-value) to WHNF when
+--    inserting into a Map.
+-- 2. Functions is Data.Map.Lazy do not force values when inserting into a Map.
+--
+-- These are ensured by testing against bottom. If a function is strict in the
+-- value, an attempt to create a Map with a bottom value will result in a Map
+-- that is bottom. If a function is lazy and the bottom value is not forced, the
+-- result will be a non-bottom Map.
+--
+-- Every function defined in Data.Map.Strict.Internal and the corresponding
+-- functions in Data.Map.Lazy should be tested here for their expected
+-- strictness properties.
+--
+-- Functions with implementations shared between Data.Map.Lazy and
+-- Data.Map.Strict never insert values and only remove them or shuffle them
+-- around. These functions do not need to be tested here.
+--
+-- For strict Map functions, the strictness is tested in one of two ways:
+--
+-- * Directly. For example, the result of `alter` is bottom if and only if the
+--   key exists in the map and the alter function applied to the key's value
+--   returns `Just <bottom>`.
+-- * Indirectly against another equivalent function, which must also be tested.
+--   For instance, `adjust f` is expected to be equivalent to `alter (fmap f)`,
+--   and is tested to be so in strictness.
+
+-- Note [Testing with lazy functions]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- To generate arbitrary functions, the obvious choice is QuickCheck's Fun.
+-- However, these functions are always strict, and using only strict functions
+-- in tests can fail to catch bugs.
+--
+-- For example, consider that
+-- `Data.Map.Strict.fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a`
+-- starts to force every `a` in the list to WHNF. This is a bug.
+--
+-- We have a strictness test which checks that for arbitrary `f` and `kvs`,
+--   isBottom (fromListWith f kvs) ===
+--   isBottom (foldl' (\acc (k,x) -> insertWith f k x acc) empty kvs)
+--
+-- If `f` is strict in both arguments, the test will not be able to detect the
+-- bug. We need a lazy function to observe the difference, such as
+--
+-- fromListWith (\_ c -> c) [(1,'a'), (1,undefined)]
+--
+-- which would result in `undefined` instead of the correct
+-- `fromList [(1,'a')]`.
+--
+-- This is why we use potentially lazy functions Func, Func2, Func3 from
+-- Utils.Strictness. Note that this measure may be unnecessary depending on the
+-- test (if there is no possibility of the function being called with bottom),
+-- but it is easy and harmless to just use the lazy functions everywhere.
+
+prop_strictSingleton :: OrdA -> Bot A -> Property
+prop_strictSingleton k (Bot x) = isBottom (M.singleton k x) === isBottom x
+
+prop_lazySingleton :: OrdA -> Bot A -> Property
+prop_lazySingleton k (Bot x) = isNotBottomProp (L.singleton k x)
+
+prop_strictFromSet :: Func OrdA (Bot A) -> Set OrdA -> Property
+prop_strictFromSet fun set =
+  isBottom (M.fromSet f set) === any (isBottom . f) (Set.toList set)
+  where
+    f = coerce (applyFunc fun) :: OrdA -> A
+
+prop_lazyFromSet :: Func OrdA (Bot A) -> Set OrdA -> Property
+prop_lazyFromSet fun set = isNotBottomProp (L.fromSet f set)
+  where
+    f = coerce (applyFunc fun) :: OrdA -> A
+
+prop_strictFromArgSet :: Func OrdA (Bot A) -> Set OrdA -> Property
+prop_strictFromArgSet fun set =
+  isBottom (M.fromArgSet set') ===
+  any (\(Arg _ x) -> isBottom x) (Set.toList set')
+  where
+    f = coerce (applyFunc fun) :: OrdA -> A
+    -- Workaround for missing Arbitrary (Arg a b)
+    set' = Set.map (\x -> Arg x (f x)) set
+
+prop_lazyFromArgSet :: Func OrdA (Bot A) -> Set OrdA -> Property
+prop_lazyFromArgSet fun set = isNotBottomProp (L.fromArgSet set')
+  where
+    f = coerce (applyFunc fun) :: OrdA -> A
+    -- Workaround for missing Arbitrary (Arg a b)
+    set' = Set.map (\x -> Arg x (f x)) set
+
+prop_strictFromList :: [(OrdA, Bot A)] -> Property
+prop_strictFromList kvs =
+  isBottom (M.fromList kvs') === any (isBottom . snd) kvs'
+  where
+    kvs' = coerce kvs :: [(OrdA, A)]
+
+prop_lazyFromList :: [(OrdA, Bot A)] -> Property
+prop_lazyFromList kvs = isNotBottomProp (L.fromList kvs')
+  where
+    kvs' = coerce kvs :: [(OrdA, A)]
+
+prop_strictFromListWith :: Func2 A A (Bot A) -> [(OrdA, 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 :: [(OrdA, A)]
+
+prop_lazyFromListWith :: Func2 A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromListWith fun kvs = isNotBottomProp (L.fromListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = coerce kvs :: [(OrdA, A)]
+
+prop_strictFromListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, 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 :: [(OrdA, A)]
+
+prop_lazyFromListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromListWithKey fun kvs = isNotBottomProp (L.fromListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = coerce kvs :: [(OrdA, A)]
+
+prop_strictFromAscList :: [(OrdA, Bot A)] -> Property
+prop_strictFromAscList kvs =
+  isBottom (M.fromAscList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromAscList :: [(OrdA, Bot A)] -> Property
+prop_lazyFromAscList kvs = isNotBottomProp (L.fromAscList kvs')
+  where
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromAscListWith :: Func2 A A (Bot A) -> [(OrdA, 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) :: [(OrdA, A)]
+
+prop_lazyFromAscListWith :: Func2 A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromAscListWith fun kvs = isNotBottomProp (L.fromAscListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromAscListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, 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) :: [(OrdA, A)]
+
+prop_lazyFromAscListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromAscListWithKey fun kvs =
+  isNotBottomProp (L.fromAscListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromDistinctAscList :: [(OrdA, Bot A)] -> Property
+prop_strictFromDistinctAscList kvs =
+  isBottom (M.fromDistinctAscList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromDistinctAscList :: [(OrdA, Bot A)] -> Property
+prop_lazyFromDistinctAscList kvs = isNotBottomProp (L.fromDistinctAscList kvs')
+  where
+    kvs' = uniqOn fst $ List.sortBy (comparing fst) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromDescList :: [(OrdA, Bot A)] -> Property
+prop_strictFromDescList kvs =
+  isBottom (M.fromDescList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromDescList :: [(OrdA, Bot A)] -> Property
+prop_lazyFromDescList kvs = isNotBottomProp (L.fromDescList kvs')
+  where
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromDescListWith :: Func2 A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_strictFromDescListWith fun kvs =
+  isBottom (M.fromDescListWith f kvs') === isBottom (M.fromListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromDescListWith :: Func2 A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromDescListWith fun kvs = isNotBottomProp (L.fromDescListWith f kvs')
+  where
+    f = coerce (applyFunc2 fun)
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromDescListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_strictFromDescListWithKey fun kvs =
+  isBottom (M.fromDescListWithKey f kvs') ===
+  isBottom (M.fromListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromDescListWithKey
+  :: Func3 OrdA A A (Bot A) -> [(OrdA, Bot A)] -> Property
+prop_lazyFromDescListWithKey fun kvs =
+  isNotBottomProp (L.fromDescListWithKey f kvs')
+  where
+    f = coerce (applyFunc3 fun)
+    kvs' = List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictFromDistinctDescList :: [(OrdA, Bot A)] -> Property
+prop_strictFromDistinctDescList kvs =
+  isBottom (M.fromDistinctDescList kvs') === isBottom (M.fromList kvs')
+  where
+    kvs' =
+      uniqOn fst $
+      List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_lazyFromDistinctDescList :: [(OrdA, Bot A)] -> Property
+prop_lazyFromDistinctDescList kvs =
+  isNotBottomProp (L.fromDistinctDescList kvs')
+  where
+    kvs' =
+      uniqOn fst $
+      List.sortBy (comparing (Down . fst)) (coerce kvs) :: [(OrdA, A)]
+
+prop_strictInsert :: OrdA -> Bot A -> Map OrdA A -> Property
+prop_strictInsert k (Bot x) m = isBottom (M.insert k x m) === isBottom x
+
+prop_lazyInsert :: OrdA -> Bot A -> Map OrdA A -> Property
+prop_lazyInsert k (Bot x) m = isNotBottomProp (L.insert k x m)
+
+prop_strictInsertWith
+  :: Func2 A A (Bot A)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA 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)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA A
+  -> Property
+prop_lazyInsertWith fun k (Bot x) m = isNotBottomProp (L.insertWith f k x m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictInsertWithKey
+  :: Func3 OrdA A A (Bot A)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA 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 OrdA A A (Bot A)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA A
+  -> Property
+prop_lazyInsertWithKey fun k (Bot x) m =
+  isNotBottomProp (L.insertWithKey f k x m)
+  where
+    f = coerce (applyFunc3 fun)
+
+prop_strictInsertLookupWithKey
+  :: Func3 OrdA A A (Bot A)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA 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 OrdA A A (Bot A)
+  -> OrdA
+  -> Bot A
+  -> Map OrdA 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) -> OrdA -> Map OrdA 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) -> OrdA -> Map OrdA A -> Property
+prop_lazyAdjust fun k m = isNotBottomProp (L.adjust f k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictAdjustWithKey
+  :: Func2 OrdA A (Bot A) -> OrdA -> Map OrdA 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 OrdA A (Bot A) -> OrdA -> Map OrdA 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)) -> OrdA -> Map OrdA 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)) -> OrdA -> Map OrdA A -> Property
+prop_lazyUpdate fun k m = isNotBottomProp (L.update f k m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateWithKey
+  :: Func2 OrdA A (Maybe (Bot A)) -> OrdA -> Map OrdA 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 OrdA A (Maybe (Bot A)) -> OrdA -> Map OrdA A -> Property
+prop_lazyUpdateWithKey fun k m = isNotBottomProp (L.updateWithKey f k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdateLookupWithKey
+  :: Func2 OrdA A (Maybe (Bot A)) -> OrdA -> Map OrdA 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 OrdA A (Maybe (Bot A)) -> OrdA -> Map OrdA 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)) -> OrdA -> Map OrdA 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)) -> OrdA -> Map OrdA 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))) -> OrdA -> Map OrdA 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))) -> OrdA -> Map OrdA 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) -> Map OrdA A -> Map OrdA 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) -> Map OrdA A -> Map OrdA A -> Property
+prop_lazyUnionWith fun m1 m2 = isNotBottomProp (L.unionWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUnionWithKey
+  :: Func3 OrdA A A (Bot A) -> Map OrdA A -> Map OrdA 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 OrdA A A (Bot A) -> Map OrdA A -> Map OrdA 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) -> [Map OrdA 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) -> [Map OrdA A] -> Property
+prop_lazyUnionsWith fun ms = isNotBottomProp (L.unionsWith f ms)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictDifferenceWith
+  :: Func2 A B (Maybe (Bot A))
+  -> Map OrdA A
+  -> Map OrdA 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))
+  -> Map OrdA A
+  -> Map OrdA B
+  -> Property
+prop_lazyDifferenceWith fun m1 m2 = isNotBottomProp (L.differenceWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictDifferenceWithKey
+  :: Func3 OrdA A B (Maybe (Bot A))
+  -> Map OrdA A
+  -> Map OrdA 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 OrdA A B (Maybe (Bot A))
+  -> Map OrdA A
+  -> Map OrdA 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)
+  -> Map OrdA A
+  -> Map OrdA 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)
+  -> Map OrdA A
+  -> Map OrdA B
+  -> Property
+prop_lazyIntersectionWith fun m1 m2 =
+  isNotBottomProp (L.intersectionWith f m1 m2)
+  where
+    f = coerce (applyFunc2 fun) :: A -> B -> C
+
+prop_strictIntersectionWithKey
+  :: Func3 OrdA A B (Bot C)
+  -> Map OrdA A
+  -> Map OrdA 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) :: OrdA -> A -> B -> C
+
+prop_lazyIntersectionWithKey
+  :: Func3 OrdA A B (Bot C)
+  -> Map OrdA A
+  -> Map OrdA B
+  -> Property
+prop_lazyIntersectionWithKey fun m1 m2 =
+  isNotBottomProp (L.intersectionWithKey f m1 m2)
+  where
+    f = coerce (applyFunc3 fun) :: OrdA -> A -> B -> C
+
+prop_strictMergeWithKey
+  :: Func3 OrdA A B (Maybe (Bot C))
+  -> Fun A (Maybe C)
+  -> Fun B (Maybe C)
+  -> Map OrdA A
+  -> Map OrdA 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) :: OrdA -> A -> B -> Maybe C
+    f1 = applyFun fun1
+    f2 = applyFun fun2
+
+prop_lazyMergeWithKey
+  :: Func3 OrdA A B (Maybe (Bot C))
+  -> Fun A (Maybe C)
+  -> Fun B (Maybe C)
+  -> Map OrdA A
+  -> Map OrdA 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) :: OrdA -> A -> B -> Maybe C
+    f1 = applyFun fun1
+    f2 = applyFun fun2
+
+prop_strictMap :: Func A (Bot B) -> Map OrdA 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) -> Map OrdA A -> Property
+prop_lazyMap fun m = isNotBottomProp (L.map f m)
+  where
+    f = coerce (applyFunc fun) :: A -> B
+
+prop_strictMapWithKey :: Func2 OrdA A (Bot B) -> Map OrdA A -> Property
+prop_strictMapWithKey fun m =
+  isBottom (M.mapWithKey f m) ===
+  any (isBottom . uncurry f) (M.toList m)
+  where
+    f = coerce (applyFunc2 fun) :: OrdA -> A -> B
+
+prop_lazyMapWithKey :: Func2 OrdA A (Bot B) -> Map OrdA A -> Property
+prop_lazyMapWithKey fun m = isNotBottomProp (L.mapWithKey f m)
+  where
+    f = coerce (applyFunc2 fun) :: OrdA -> A -> B
+
+prop_strictTraverseWithKey
+  :: Func2 OrdA A (Identity (Bot B)) -> Map OrdA 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) :: OrdA -> A -> Identity B
+
+prop_lazyTraverseWithKey
+  :: Func2 OrdA A (Identity (Bot B)) -> Map OrdA A -> Property
+prop_lazyTraverseWithKey fun m =
+  isNotBottomProp (runIdentity (L.traverseWithKey f m))
+  where
+    f = coerce (applyFunc2 fun) :: OrdA -> A -> Identity B
+
+prop_strictTraverseMaybeWithKey
+  :: Func2 OrdA A (Identity (Maybe (Bot B))) -> Map OrdA 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) :: OrdA -> A -> Identity (Maybe B)
+
+prop_lazyTraverseMaybeWithKey
+  :: Func2 OrdA A (Identity (Maybe (Bot B))) -> Map OrdA A -> Property
+prop_lazyTraverseMaybeWithKey fun m =
+  isNotBottomProp (runIdentity (L.traverseMaybeWithKey f m))
+  where
+    f = coerce (applyFunc2 fun) :: OrdA -> A -> Identity (Maybe B)
+
+prop_strictMapAccum :: Func2 A B (A, Bot C) -> A -> Map OrdA 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 -> Map OrdA 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 OrdA B (A, Bot C) -> A -> Map OrdA 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 -> OrdA -> B -> (A, C)
+
+prop_lazyMapAccumWithKey
+  :: Func3 A OrdA B (A, Bot C) -> A -> Map OrdA B -> Property
+prop_lazyMapAccumWithKey fun z m =
+  isNotBottomProp (snd (L.mapAccumWithKey f z m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> OrdA -> B -> (A, C)
+
+prop_strictMapAccumRWithKey
+  :: Func3 A OrdA B (A, Bot C) -> A -> Map OrdA 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 -> OrdA -> B -> (A, C)
+
+prop_lazyMapAccumRWithKey
+  :: Func3 A OrdA B (A, Bot C) -> A -> Map OrdA B -> Property
+prop_lazyMapAccumRWithKey fun z m =
+  isNotBottomProp (snd (L.mapAccumRWithKey f z m))
+  where
+    f = coerce (applyFunc3 fun) :: A -> OrdA -> B -> (A, C)
+
+prop_strictMapKeysWith
+  :: Func2 A A (Bot A) -> Func OrdA OrdB -> Map OrdA 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 OrdA OrdB -> Map OrdA 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)) -> Map OrdA 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)) -> Map OrdA A -> Property
+prop_lazyMapMaybe fun m = isNotBottomProp (L.mapMaybe f m)
+  where
+    f = coerce (applyFunc fun) :: A -> Maybe B
+
+prop_strictMapMaybeWithKey
+  :: Func2 OrdA A (Maybe (Bot B)) -> Map OrdA 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) :: OrdA -> A -> Maybe B
+
+prop_lazyMapMaybeWithKey
+  :: Func2 OrdA A (Maybe (Bot B)) -> Map OrdA A -> Property
+prop_lazyMapMaybeWithKey fun m = isNotBottomProp (L.mapMaybeWithKey f m)
+  where
+    f = coerce (applyFunc2 fun) :: OrdA -> A -> Maybe B
+
+prop_strictMapEither
+  :: Func A (Either (Bot B) (Bot C)) -> Map OrdA 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)) -> Map OrdA 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 OrdA A (Either (Bot B) (Bot C)) -> Map OrdA 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) :: OrdA -> A -> Either B C
+
+prop_lazyMapEitherWithKey
+ :: Func2 OrdA A (Either (Bot B) (Bot C)) -> Map OrdA 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) :: OrdA -> A -> Either B C
+
+prop_strictUpdateAt :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
+prop_strictUpdateAt fun m = not (M.null m) ==>
+  forAll (choose (0, M.size m - 1)) $ \k ->
+    isBottom (M.updateAt (\k' x -> Just (f k' x)) k m) ===
+    isBottom (uncurry f (M.elemAt k m))
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_lazyUpdateAt :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
+prop_lazyUpdateAt fun m = not (L.null m) ==>
+  forAll (choose (0, L.size m - 1)) $ \k ->
+    isNotBottomProp (L.updateAt (\k' x -> Just (f k' x)) k m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdateMin :: Func A (Bot A) -> Map OrdA 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) -> Map OrdA A -> Property
+prop_lazyUpdateMin fun m = isNotBottomProp (L.updateMin (Just . f) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateMinWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
+prop_strictUpdateMinWithKey fun m = not (M.null m) ==>
+  isBottom (M.updateMinWithKey (\k x -> Just (f k x)) m) ===
+  isBottom (uncurry f (M.findMin 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) ==>
+  isNotBottomProp (L.updateMinWithKey (\k x -> Just (f k x)) m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictUpdateMax :: Func A (Bot A) -> Map OrdA 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) -> Map OrdA A -> Property
+prop_lazyUpdateMax fun m = isNotBottomProp (L.updateMax (Just . f) m)
+  where
+    f = coerce (applyFunc fun)
+
+prop_strictUpdateMaxWithKey :: Func2 OrdA A (Bot A) -> Map OrdA A -> Property
+prop_strictUpdateMaxWithKey fun m = not (M.null m) ==>
+  isBottom (M.updateMaxWithKey (\k x -> Just (f k x)) m) ===
+  isBottom (uncurry f (M.findMax 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) ==>
+  isNotBottomProp (L.updateMaxWithKey (\k x -> Just (f k x)) m)
+  where
+    f = coerce (applyFunc2 fun)
+
+prop_strictMerge
+  :: WhenMissingFunc OrdA A (Bot C) C (Bot C)
+  -> WhenMissingFunc OrdA B (Bot C) C (Bot C)
+  -> WhenMatchedFunc OrdA A B (Bot C) C (Bot C)
+  -> Map OrdA A
+  -> Map OrdA 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 OrdA A C C C
+    misfun2' = coerce misfun2 :: WhenMissingFunc OrdA B C C C
+    matfun' = coerce matfun :: WhenMatchedFunc OrdA 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 OrdA A (Bot C) C (Bot C)
+  -> WhenMissingFunc OrdA B (Bot C) C (Bot C)
+  -> WhenMatchedFunc OrdA A B (Bot C) C (Bot C)
+  -> Map OrdA A
+  -> Map OrdA B
+  -> Property
+prop_lazyMerge misfun1 misfun2 matfun m1 m2 =
+  isNotBottomProp (MMerge.merge mis1 mis2 mat m1 m2)
+  where
+    mis1 = toLazyWhenMissing (coerce misfun1 :: WhenMissingFunc OrdA A C C C)
+    mis2 = toLazyWhenMissing (coerce misfun2 :: WhenMissingFunc OrdA B C C C)
+    mat = toLazyWhenMatched (coerce matfun :: WhenMatchedFunc OrdA A B C C C)
+
+prop_strictMergeA
+  :: WhenMissingFunc OrdA A (Bot C) C (Bot C)
+  -> WhenMissingFunc OrdA B (Bot C) C (Bot C)
+  -> WhenMatchedFunc OrdA A B (Bot C) C (Bot C)
+  -> Map OrdA A
+  -> Map OrdA 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 OrdA A C C C
+    misfun2' = coerce misfun2 :: WhenMissingFunc OrdA B C C C
+    matfun' = coerce matfun :: WhenMatchedFunc OrdA 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 OrdA A (Bot C) C (Bot C)
+  -> WhenMissingFunc OrdA B (Bot C) C (Bot C)
+  -> WhenMatchedFunc OrdA A B (Bot C) C (Bot C)
+  -> Map OrdA A
+  -> Map OrdA B
+  -> Property
+prop_lazyMergeA misfun1 misfun2 matfun m1 m2 =
+  isNotBottomProp (runIdentity (LMerge.mergeA mis1 mis2 mat m1 m2))
+  where
+    mis1 = toLazyWhenMissingA (coerce misfun1 :: WhenMissingFunc OrdA A C C C)
+    mis2 = toLazyWhenMissingA (coerce misfun2 :: WhenMissingFunc OrdA B C C C)
+    mat = toLazyWhenMatchedA (coerce matfun :: WhenMatchedFunc OrdA A B C C C)
 
 ------------------------------------------------------------------------
 -- ** Strict module
@@ -108,74 +1030,6 @@ pStrictFoldlWithKey' :: Map Int Int -> Property
 pStrictFoldlWithKey' m = whnfHasNoThunks (M.foldlWithKey' (\as _ a -> a : as) [] 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
-
-#if __GLASGOW_HASKELL__ >= 806
-pStrictFromDistinctDescList :: [Int] -> Property
-pStrictFromDistinctDescList = whnfHasNoThunks . evalSpine . M.elems . M.fromDistinctDescList . zip [0::Int, -1 ..] . 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 "Map.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 -> M.Map Int () -> 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 "Map.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.Map Int () -> 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
 
@@ -207,14 +1061,71 @@ tests =
       , testProperty "strict foldl'" pStrictFoldl'
       , testProperty "strict foldrWithKey'" pStrictFoldrWithKey'
       , testProperty "strict foldlWithKey'" pStrictFoldlWithKey'
-      , testProperty "strict fromDistinctAscList" pStrictFromDistinctAscList
-      , testProperty "strict fromDistinctDescList" pStrictFromDistinctDescList
 #endif
       ]
-      , tExtraThunksM
-      , tExtraThunksL
+    , testGroup "Construction"
+      [ testPropStrictLazy "singleton" prop_strictSingleton prop_lazySingleton
+      , testPropStrictLazy "fromSet" prop_strictFromSet prop_lazyFromSet
+      , testPropStrictLazy "fromArgSet" prop_strictFromArgSet prop_lazyFromArgSet
+      , 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 "fromDescList" prop_strictFromDescList prop_lazyFromDescList
+      , testPropStrictLazy "fromDescListWith" prop_strictFromDescListWith prop_lazyFromDescListWith
+      , testPropStrictLazy "fromDescListWithKey" prop_strictFromDescListWithKey prop_lazyFromDescListWithKey
+      , testPropStrictLazy "fromDistinctDescList" prop_strictFromDistinctDescList prop_lazyFromDistinctDescList
+      , 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 "updateAt" prop_strictUpdateAt prop_lazyUpdateAt
+      , 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
 
@@ -227,9 +1138,204 @@ main = defaultMain $ testGroup "map-strictness" tests
 keyStrict :: (Int -> Map Int Int -> a) -> Map Int 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
+--------------------------------------------------------------------}
+
+-- 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
+  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 k x y z z z2 -> WhenMatched Identity k 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 k x y z z z2 -> WhenMatched Identity k 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 k x y z z z2 -> WhenMatched Identity k 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 k x y z z z2 -> k -> 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
+
+-- 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)
+  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 k x y y y2 -> WhenMissing Identity k 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 k x y y y2 -> WhenMissing Identity k 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 k x y y y2 -> WhenMissing Identity k 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 k x y y y2 -> k -> 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/set-properties.hs b/containers-tests/tests/set-properties.hs
index 83b7ba4c7..07b5bfc39 100644
--- a/containers-tests/tests/set-properties.hs
+++ b/containers-tests/tests/set-properties.hs
@@ -2,7 +2,6 @@
 import qualified Data.IntSet as IntSet
 import Data.List (nub, sort, sortBy)
 import qualified Data.List as List
-import Data.Monoid (mempty)
 import Data.Maybe
 import Data.Set
 import Prelude hiding (lookup, null, map, filter, foldr, foldl, foldl', all, take, drop, splitAt)
@@ -12,7 +11,6 @@ import Test.Tasty.QuickCheck
 import Test.QuickCheck.Function (apply)
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Trans.Class
-import Control.Monad (liftM, liftM3)
 import Data.Functor.Identity
 import Data.Foldable (all)
 import Data.Ord (Down(..), comparing)
@@ -20,6 +18,7 @@ import Control.Applicative (liftA2)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 
+import Utils.ArbitrarySetMap (mkArbSet, setFromList)
 #if __GLASGOW_HASKELL__ >= 806
 import Utils.NoThunks (whnfHasNoThunks)
 #endif
@@ -230,7 +229,7 @@ instance IsInt a => Arbitrary (Set a) where
         middle <- choose (-positionFactor * (sz + 1), positionFactor * (sz + 1))
         let shift = (sz * (gapRange) + 1) `quot` 2
             start = middle - shift
-        t <- evalStateT (mkArb step sz) start
+        t <- evalStateT (mkArbSet step sz) start
         if valid t then pure t else error "Test generated invalid tree!")
     where
       step = do
@@ -240,47 +239,6 @@ instance IsInt a => Arbitrary (Set a) where
         put i'
         pure (fromInt i')
 
-class Monad m => MonadGen m where
-  liftGen :: Gen a -> m a
-instance MonadGen Gen where
-  liftGen = id
-instance MonadGen m => MonadGen (StateT s m) where
-  liftGen = lift . liftGen
-
--- | Given an action that produces successively larger elements and
--- a size, produce a set of arbitrary shape with exactly that size.
-mkArb :: MonadGen m => m a -> Int -> m (Set a)
-mkArb step n
-  | n <= 0 = return Tip
-  | n == 1 = singleton `liftM` step
-  | n == 2 = do
-     dir <- liftGen arbitrary
-     p <- step
-     q <- step
-     if dir
-       then return (Bin 2 q (singleton p) Tip)
-       else return (Bin 2 p Tip (singleton q))
-  | otherwise = do
-      -- This assumes a balance factor of delta = 3
-      let upper = (3*(n - 1)) `quot` 4
-      let lower = (n + 2) `quot` 4
-      ln <- liftGen $ choose (lower, upper)
-      let rn = n - ln - 1
-      liftM3 (\lt x rt -> Bin n x lt rt) (mkArb step ln) step (mkArb step rn)
-
--- | Given a strictly increasing list of elements, produce an arbitrarily
--- shaped set with exactly those elements.
-setFromList :: [a] -> Gen (Set a)
-setFromList xs = flip evalStateT xs $ mkArb step (length xs)
-  where
-    step = do
-      xxs <- get
-      case xxs of
-        x : xs -> do
-          put xs
-          pure x
-        [] -> error "setFromList"
-
 data TwoSets = TwoSets (Set Int) (Set Int) deriving (Show)
 
 data TwoLists a = TwoLists [a] [a]