diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,40 @@
+1.5.4.0 [2025-01-18]
+--------------------
+* Mini.Data.Map:
+  * Add:
+    * 'fromDistinct{Asc,Desc}List'
+    * 'from{Asc,Desc}List{,With,WithKey}'
+  * Major improvements to:
+    * 'filter{,WithKey}'
+    * 'partition{,WithKey}'
+    * 'split'
+  * Minor improvements to:
+    * 'compose'
+    * 'difference'
+    * 'differenceWithKey'
+    * 'intersectionWithKey'
+    * 'unionWithKey'
+    * 'delete{Max,Min}'
+    * 'update{,Max,Min}WithKey'
+    * 'split{Max,Min}'
+    * 'disjoint'
+    * 'isSubmapOfBy'
+* Mini.Data.Set:
+  * Add:
+    * 'from{Distinct,}{Asc,Desc}List'
+  * Major improvements to:
+    * 'filter'
+    * 'partition'
+    * 'split'
+  * Minor improvements to:
+    * 'difference'
+    * 'intersection'
+    * 'union'
+    * 'delete{Max,Min}'
+    * 'split{Max,Min}'
+    * 'disjoint'
+    * 'isSubsetOf'
+
 1.5.3.0 [2025-01-09]
 --------------------
 * Mini.Transformers.ParserT:
diff --git a/Mini/Data/Map.hs b/Mini/Data/Map.hs
--- a/Mini/Data/Map.hs
+++ b/Mini/Data/Map.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE TupleSections #-}
+-- incomplete patterns in 'fromDistinct{Asc,Desc}List'
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- | A structure mapping unique keys to values
 module Mini.Data.Map (
@@ -7,10 +9,18 @@
 
   -- * Construction
   empty,
+  singleton,
   fromList,
   fromListWith,
   fromListWithKey,
-  singleton,
+  fromAscList,
+  fromAscListWith,
+  fromAscListWithKey,
+  fromDescList,
+  fromDescListWith,
+  fromDescListWithKey,
+  fromDistinctAscList,
+  fromDistinctDescList,
 
   -- * Combination
   compose,
@@ -94,9 +104,17 @@
   liftA2,
   (<|>),
  )
+import Data.Bifunctor (
+  bimap,
+  first,
+  second,
+ )
 import Data.Bool (
   bool,
  )
+import Data.Function (
+  on,
+ )
 import Prelude (
   Applicative,
   Bool (
@@ -123,22 +141,27 @@
   Traversable,
   compare,
   const,
+  div,
   error,
   flip,
   fmap,
   foldl,
   foldr,
   fst,
+  length,
   max,
   maybe,
   mempty,
   not,
   pure,
   show,
+  splitAt,
   traverse,
   uncurry,
+  until,
   ($),
   (&&),
+  (*),
   (+),
   (-),
   (.),
@@ -167,10 +190,10 @@
     R (Map k a) k a (Map k a)
 
 instance (Eq k, Eq a) => Eq (Map k a) where
-  t1 == t2 = toAscList t1 == toAscList t2
+  (==) = (==) `on` toAscList
 
 instance (Ord k, Ord a) => Ord (Map k a) where
-  compare t1 t2 = compare (toAscList t1) (toAscList t2)
+  compare = compare `on` toAscList
 
 instance (Show k, Show a) => Show (Map k a) where
   show = show . toAscList
@@ -220,6 +243,10 @@
 empty :: Map k a
 empty = E
 
+-- | /O(1)/ Make a map with a single bin
+singleton :: k -> a -> Map k a
+singleton k a = B E k a E
+
 -- | /O(n log n)/ Make a map from a tail-biased list of @(key, value)@ pairs
 fromList :: (Ord k) => [(k, a)] -> Map k a
 fromList = fromListWithKey $ const const
@@ -232,24 +259,76 @@
 fromListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a
 fromListWithKey f = foldl (flip . uncurry $ insertWithKey f) empty
 
--- | /O(1)/ Make a map with a single bin
-singleton :: k -> a -> Map k a
-singleton k a = B E k a E
+-- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs
+fromAscList :: (Eq k) => [(k, a)] -> Map k a
+fromAscList = fromDistinctAscList . essence
 
+-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys
+fromAscListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a
+fromAscListWith = fromAscListWithKey . const
+
+-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys
+fromAscListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a
+fromAscListWithKey f = fromDistinctAscList . essenceWith f
+
+-- | /O(n)/ Make a map from a tail-biased list of key-sorted pairs
+fromDescList :: (Eq k) => [(k, a)] -> Map k a
+fromDescList = fromDistinctDescList . essence
+
+-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys
+fromDescListWith :: (Ord k) => (a -> a -> a) -> [(k, a)] -> Map k a
+fromDescListWith = fromDescListWithKey . const
+
+-- | /O(n)/ Make a map from a list of key-sorted pairs, combining matching keys
+fromDescListWithKey :: (Ord k) => (k -> a -> a -> a) -> [(k, a)] -> Map k a
+fromDescListWithKey f = fromDistinctDescList . essenceWith f
+
+-- | /O(n)/ Make a map from a sorted list of key-distinct pairs
+fromDistinctAscList :: [(k, a)] -> Map k a
+fromDistinctAscList = go <*> power
+ where
+  go [] _ = E
+  go [(k, a)] _ = B E k a E
+  go kas n =
+    let len = length kas
+        n' = n `div` 2
+        c = bool B L $ len == n
+        (l, (k, a) : r) = splitAt (len `div` 2) kas
+     in c (go l n') k a (go r n')
+
+-- | /O(n)/ Make a map from a sorted list of key-distinct pairs
+fromDistinctDescList :: [(k, a)] -> Map k a
+fromDistinctDescList = go <*> power
+ where
+  go [] _ = E
+  go [(k, a)] _ = B E k a E
+  go kas n =
+    let len = length kas
+        n' = n `div` 2
+        c = bool B R $ len == n
+        (l, (k, a) : r) = splitAt (len `div` 2) kas
+     in c (go r n') k a (go l n')
+
 {-
  - Combination
  -}
 
 -- | /O(n log m)/ Compose the keys of one set with the values of another
-compose :: (Ord b, Ord a) => Map b c -> Map a b -> Map a c
-compose bc =
-  foldrWithKey
-    (\a b ac -> maybe ac (\c -> insert a c ac) $ lookup b bc)
-    empty
+compose :: (Ord b) => Map b c -> Map a b -> Map a c
+compose t1 t2 = map empty go go go t1
+ where
+  go _ _ _ _ _ _ =
+    fromDistinctAscList $
+      foldrWithKey
+        (\a b ac -> maybe ac (\c -> (a, c) : ac) $ lookup b t1)
+        []
+        t2
 
 -- | /O(m log n)/ Subtract a map by another via key matching
 difference :: (Ord k) => Map k a -> Map k b -> Map k a
-difference = foldrWithKey (\k _ b -> delete k b)
+difference t1 t2 = map empty go go go t1
+ where
+  go _ _ _ _ _ _ = foldrWithKey (\k _ b -> delete k b) t1 t2
 
 -- | /O(m log n)/ Subtract a map by another, updating bins of matching keys
 differenceWith
@@ -259,20 +338,23 @@
 -- | /O(m log n)/ Subtract a map by another, updating bins of matching keys
 differenceWithKey
   :: (Ord k) => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
-differenceWithKey f t =
-  foldrWithKey
-    ( \k b t' ->
-        maybe
-          t'
-          ( \a ->
-              maybe
-                (delete k t')
-                (\a' -> insert k a' t')
-                $ f k a b
-          )
-          $ lookup k t
-    )
-    t
+differenceWithKey f t1 t2 = map empty go go go t1
+ where
+  go _ _ _ _ _ _ =
+    foldrWithKey
+      ( \k b t' ->
+          maybe
+            t'
+            ( \a ->
+                maybe
+                  (delete' k t')
+                  (\a' -> insert k a' t')
+                  $ f k a b
+            )
+            $ lookup k t1
+      )
+      t1
+      t2
 
 -- | /O(n log m)/ Intersect a map with another via left-biased key matching
 intersection :: (Ord k) => Map k a -> Map k b -> Map k a
@@ -285,11 +367,14 @@
 -- | /O(n log m)/ Intersect a map with another by key matching, combining values
 intersectionWithKey
   :: (Ord k) => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
-intersectionWithKey f t1 t2 =
-  foldrWithKey
-    (\k a c -> maybe c (\b -> insert k (f k a b) c) $ lookup k t2)
-    empty
-    t1
+intersectionWithKey f t1 t2 = map empty go go go t2
+ where
+  go _ _ _ _ _ _ =
+    fromDistinctAscList $
+      foldrWithKey
+        (\k a c -> maybe c (\b -> (k, f k a b) : c) $ lookup k t2)
+        []
+        t1
 
 -- | /O(m log n)/ Unite a map with another via left-biased key matching
 union :: (Ord k) => Map k a -> Map k a -> Map k a
@@ -301,7 +386,9 @@
 
 -- | /O(m log n)/ Unite a map with another, combining values of matching keys
 unionWithKey :: (Ord k) => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
-unionWithKey f = flip $ foldrWithKey (insertWithKey f)
+unionWithKey f t1 t2 = map t1 go go go t2
+ where
+  go _ _ _ _ _ _ = foldrWithKey (insertWithKey f) t2 t1
 
 -- | Unite a collection of maps via left-biased key matching
 unions :: (Foldable t, Ord k) => t (Map k a) -> Map k a
@@ -386,29 +473,323 @@
 
 -- | /O(log n)/ Delete a key from a map
 delete :: (Ord k) => k -> Map k a -> Map k a
-delete k0 t = bool t (go t) $ k0 `member` t
+delete k t = bool t (delete' k t) $ k `member` t
+
+-- | /O(log n)/ Delete the maximum key from a map
+deleteMax :: (Ord k) => Map k a -> Map k a
+deleteMax t = maybe t (flip delete' t . fst) $ lookupMax t
+
+-- | /O(log n)/ Delete the minimum key from a map
+deleteMin :: (Ord k) => Map k a -> Map k a
+deleteMin t = maybe t (flip delete' t . fst) $ lookupMin t
+
+-- | /O(n)/ Keep the bins whose values satisfy a predicate
+filter :: (a -> Bool) -> Map k a -> Map k a
+filter = filterWithKey . const
+
+-- | /O(n)/ Keep the bins whose keys and values satisfy a predicate
+filterWithKey :: (k -> a -> Bool) -> Map k a -> Map k a
+filterWithKey p =
+  fromDistinctAscList
+    . foldrWithKey (\k a b -> bool b ((k, a) : b) $ p k a) []
+
+-- | /O(log n)/ Insert a key and its value into a map, overwriting if present
+insert :: (Ord k) => k -> a -> Map k a -> Map k a
+insert = insertWithKey $ const const
+
+-- | /O(log n)/ Insert a key and its value, combining new and old if present
+insertWith :: (Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a
+insertWith = insertWithKey . const
+
+-- | /O(log n)/ Modify the value of a key or delete its bin with an operation
+update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a
+update = updateWithKey . const
+
+-- | /O(log n)/ Modify the value of a key or delete its bin with an operation
+updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
+updateWithKey f k t =
+  maybe
+    t
+    ( maybe
+        (delete' k t)
+        (\a' -> insert k a' t)
+        . f k
+    )
+    $ lookup k t
+
+-- | /O(log n)/ Modify the value of the maximum key or delete its bin
+updateMax :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a
+updateMax = updateMaxWithKey . const
+
+-- | /O(log n)/ Modify the value of the maximum key or delete its bin
+updateMaxWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a
+updateMaxWithKey f t =
+  maybe
+    t
+    ( \(k, a) ->
+        maybe
+          (delete' k t)
+          (\a' -> insert k a' t)
+          $ f k a
+    )
+    $ lookupMax t
+
+-- | /O(log n)/ Modify the value of the minimum key or delete its bin
+updateMin :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a
+updateMin = updateMinWithKey . const
+
+-- | /O(log n)/ Modify the value of the minimum key or delete its bin
+updateMinWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a
+updateMinWithKey f t =
+  maybe
+    t
+    ( \(k, a) ->
+        maybe
+          (delete' k t)
+          (\a' -> insert k a' t)
+          $ f k a
+    )
+    $ lookupMin t
+
+{-
+ - Partition
+ -}
+
+-- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps
+partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a)
+partition = partitionWithKey . const
+
+-- | /O(n)/ Partition a map with a predicate into @(true, false)@ submaps
+partitionWithKey :: (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
+partitionWithKey p =
+  bimap fromDistinctAscList fromDistinctAscList
+    . foldrWithKey
+      (\k a -> bool second first (p k a) ((k, a) :))
+      ([], [])
+
+-- | /O(n)/ Split a map by a key into @(lt, eq, gt)@ submaps
+split :: (Ord k) => k -> Map k a -> (Map k a, Maybe a, Map k a)
+split k0 =
+  (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))
+    . foldrWithKey
+      ( \k a (lt, a', gt) -> case compare k k0 of
+          LT -> ((k, a) : lt, a', gt)
+          EQ -> (lt, Just a, gt)
+          GT -> (lt, a', (k, a) : gt)
+      )
+      ([], Nothing, [])
+
+-- | /O(log n)/ Split a map by its maximum key
+splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)
+splitMax t = ((,) <*> flip delete' t . fst) <$> lookupMax t
+
+-- | /O(log n)/ Split a map by its minimum key
+splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)
+splitMin t = ((,) <*> flip delete' t . fst) <$> lookupMin t
+
+{-
+ - Query
+ -}
+
+-- | /O(m log n)/ Check whether two maps have no keys in common
+disjoint :: (Ord k) => Map k a -> Map k a -> Bool
+disjoint t1 t2 = map True go go go t1
  where
-  go =
+  go _ _ _ _ _ _ = not $ foldrWithKey (\k _ b -> k `member` t1 || b) False t2
+
+-- | /O(n log m)/ Check whether the bins of one map exist in the other
+isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool
+isSubmapOf = isSubmapOfBy (==)
+
+-- | /O(n log m)/ Check if the bins of one map exist in the other by combination
+isSubmapOfBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
+isSubmapOfBy p t1 t2 = map (null t1) go go go t2
+ where
+  go _ _ _ _ _ _ =
+    foldrWithKey
+      (\k a b -> maybe False ((&& b) . p a) $ lookup k t2)
+      True
+      t1
+
+-- | /O(log n)/ Fetch the value of a key in a map, or 'Nothing' if absent
+lookup :: (Ord k) => k -> Map k a -> Maybe a
+lookup k = map Nothing go go go
+ where
+  go _ k' a _ recl recr = case compare k k' of
+    LT -> recl
+    EQ -> Just a
+    GT -> recr
+
+-- | /O(log n)/ Fetch the least bin greater than or equal to a key
+lookupGE :: (Ord k) => k -> Map k a -> Maybe (k, a)
+lookupGE k0 = map Nothing go go go
+ where
+  go _ k a _ recl recr = case compare k k0 of
+    LT -> recr
+    EQ -> Just (k, a)
+    GT -> recl <|> Just (k, a)
+
+-- | /O(log n)/ Fetch the least bin strictly greater than a key
+lookupGT :: (Ord k) => k -> Map k a -> Maybe (k, a)
+lookupGT k0 = map Nothing go go go
+ where
+  go _ k a _ recl recr = case compare k k0 of
+    LT -> recr
+    EQ -> recr
+    GT -> recl <|> Just (k, a)
+
+-- | /O(log n)/ Fetch the greatest bin less than or equal to a key
+lookupLE :: (Ord k) => k -> Map k a -> Maybe (k, a)
+lookupLE k0 = map Nothing go go go
+ where
+  go _ k a _ recl recr = case compare k k0 of
+    LT -> recr <|> Just (k, a)
+    EQ -> Just (k, a)
+    GT -> recl
+
+-- | /O(log n)/ Fetch the greatest bin strictly less than a key
+lookupLT :: (Ord k) => k -> Map k a -> Maybe (k, a)
+lookupLT k0 = map Nothing go go go
+ where
+  go _ k a _ recl recr = case compare k k0 of
+    LT -> recr <|> Just (k, a)
+    EQ -> recl
+    GT -> recl
+
+-- | /O(log n)/ Fetch the bin with the maximum key, or 'Nothing' if empty
+lookupMax :: Map k a -> Maybe (k, a)
+lookupMax = map Nothing go go go
+ where
+  go _ k a r _ recr = map (Just (k, a)) go' go' go' r
+   where
+    go' _ _ _ _ _ _ = recr
+
+-- | /O(log n)/ Fetch the bin with the minimum key, or 'Nothing' if empty
+lookupMin :: Map k a -> Maybe (k, a)
+lookupMin = map Nothing go go go
+ where
+  go l k a _ recl _ = map (Just (k, a)) go' go' go' l
+   where
+    go' _ _ _ _ _ _ = recl
+
+-- | /O(log n)/ Check whether a key is in a map
+member :: (Ord k) => k -> Map k a -> Bool
+member k0 = map False go go go
+ where
+  go _ k _ _ recl recr = case compare k0 k of
+    LT -> recl
+    EQ -> True
+    GT -> recr
+
+-- | /O(1)/ Check whether a map is empty
+null :: Map k a -> Bool
+null = map True go go go where go _ _ _ _ _ _ = False
+
+-- | /O(n)/ Get the size of a map
+size :: Map k a -> Int
+size = map 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr
+
+{-
+ - Traversal
+ -}
+
+-- | /O(n)/ Apply an operation across a map, transforming its values
+fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b
+fmapWithKey f = map E (go L) (go B) (go R)
+ where
+  go c _ k a _ recl = c recl k (f k a)
+
+-- | /O(n)/ Lift a map with a lifting operation on keys and values
+traverseWithKey :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)
+traverseWithKey f = map (pure E) (go L) (go B) (go R)
+ where
+  go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr
+
+{-
+ - Validation
+ -}
+
+-- | /O(n^2)/ Check whether a map is internally height-balanced and ordered
+valid :: (Ord k) => Map k a -> Bool
+valid = liftA2 (&&) balanced ordered
+ where
+  balanced =
     map
-      (error "Map.delete: L0")
-      ( \l k a r _ _ ->
-          case compare k0 k of
-            LT -> deleteLl l k a r
-            EQ -> substituteL l r
-            GT -> deleteLr l k a r
-      )
-      ( \l k a r _ _ ->
-          case compare k0 k of
-            LT -> deleteBl l k a r
-            EQ -> substituteBr l r
-            GT -> deleteBr l k a r
-      )
-      ( \l k a r _ _ ->
-          case compare k0 k of
-            LT -> deleteRl l k a r
-            EQ -> substituteR l r
-            GT -> deleteRr l k a r
-      )
+      True
+      (\l _ _ r recl recr -> levels l - levels r == 1 && recl && recr)
+      (\l _ _ r recl recr -> levels l - levels r == 0 && recl && recr)
+      (\l _ _ r recl recr -> levels r - levels l == 1 && recl && recr)
+  levels = map 0 go go go
+   where
+    go _ _ _ _ recl recr = 1 + max recl recr :: Int
+  ordered = map True go go go
+   where
+    go l k _ r recl recr =
+      map True lt lt lt l
+        && map True gt gt gt r
+     where
+      lt _ lk _ _ _ _ = lk < k && recl && recr
+      gt _ rk _ _ _ _ = rk > k && recl && recr
+
+{-
+ - Helpers
+ -}
+
+-- O(n) 'nub' on keys for sorted lists of pairs
+essence :: (Eq k) => [(k, a)] -> [(k, a)]
+essence [] = []
+essence (x : xs) = essence' x xs
+ where
+  essence' ka1 [] = [ka1]
+  essence' ka1@(k1, _) (ka2@(k2, _) : kas) =
+    let rest = essence' ka2 kas
+     in bool (ka1 : rest) rest $ k1 == k2
+
+-- O(n) 'nub' with a combining function for sorted lists of pairs
+essenceWith :: (Eq k) => (k -> a -> a -> a) -> [(k, a)] -> [(k, a)]
+essenceWith _ [] = []
+essenceWith f (x : xs) = essenceWith' x xs
+ where
+  essenceWith' ka1 [] = [ka1]
+  essenceWith' ka1@(k1, a1) (ka2@(k2, a2) : kas) =
+    bool
+      (ka1 : essenceWith' ka2 kas)
+      (essenceWith' (k1, f k1 a2 a1) kas)
+      $ k1 == k2
+
+-- The greatest power of 2 <= the length of a non-empty collection
+power :: (Foldable t) => t a -> Int
+power as = until (> length as) (* 2) 2 `div` 2
+
+{-
+ - Let this comment serve as your warning. Return from whence you came and your
+ - sanity will be spared. You have been admonished.
+ -}
+
+-- O(log n) Delete a key from a map without checking for membership
+delete' :: (Ord k) => k -> Map k a -> Map k a
+delete' k0 =
+  map
+    (error "Map.delete: L0")
+    ( \l k a r _ _ ->
+        case compare k0 k of
+          LT -> deleteLl l k a r
+          EQ -> substituteL l r
+          GT -> deleteLr l k a r
+    )
+    ( \l k a r _ _ ->
+        case compare k0 k of
+          LT -> deleteBl l k a r
+          EQ -> substituteBr l r
+          GT -> deleteBr l k a r
+    )
+    ( \l k a r _ _ ->
+        case compare k0 k of
+          LT -> deleteRl l k a r
+          EQ -> substituteR l r
+          GT -> deleteRr l k a r
+    )
+ where
   deleteRl l k a r =
     map
       (error "Map.delete: L1")
@@ -880,31 +1261,7 @@
     (\(r, k', a') -> (checkRightB l k a r, k', a')) $
       popRightL rl rk ra rr
 
--- | /O(log n)/ Delete the maximum key from a map
-deleteMax :: (Ord k) => Map k a -> Map k a
-deleteMax t = maybe t (flip delete t . fst) $ lookupMax t
-
--- | /O(log n)/ Delete the minimum key from a map
-deleteMin :: (Ord k) => Map k a -> Map k a
-deleteMin t = maybe t (flip delete t . fst) $ lookupMin t
-
--- | /O(n log n)/ Keep the bins whose values satisfy a predicate
-filter :: (Ord k) => (a -> Bool) -> Map k a -> Map k a
-filter = filterWithKey . const
-
--- | /O(n log n)/ Keep the bins whose keys and values satisfy a predicate
-filterWithKey :: (Ord k) => (k -> a -> Bool) -> Map k a -> Map k a
-filterWithKey p = foldrWithKey (\k a b -> bool b (insert k a b) $ p k a) empty
-
--- | /O(log n)/ Insert a key and its value into a map, overwriting if present
-insert :: (Ord k) => k -> a -> Map k a -> Map k a
-insert = insertWithKey $ const const
-
 -- | /O(log n)/ Insert a key and its value, combining new and old if present
-insertWith :: (Ord k) => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith = insertWithKey . const
-
--- | /O(log n)/ Insert a key and its value, combining new and old if present
 insertWithKey :: (Ord k) => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
 insertWithKey f k0 a0 =
   map
@@ -1092,230 +1449,6 @@
       )
       (\lrl lrk lra lrr _ _ -> L (B ll lk la (insertR lrl lrk lra lrr)) k a r)
       lr
-
--- | /O(log n)/ Modify the value of a key or delete its bin with an operation
-update :: (Ord k) => (a -> Maybe a) -> k -> Map k a -> Map k a
-update = updateWithKey . const
-
--- | /O(log n)/ Modify the value of a key or delete its bin with an operation
-updateWithKey :: (Ord k) => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
-updateWithKey f k t =
-  maybe
-    t
-    ( maybe
-        (delete k t)
-        (\a' -> insert k a' t)
-        . f k
-    )
-    $ lookup k t
-
--- | /O(log n)/ Modify the value of the maximum key or delete its bin
-updateMax :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a
-updateMax = updateMaxWithKey . const
-
--- | /O(log n)/ Modify the value of the maximum key or delete its bin
-updateMaxWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a
-updateMaxWithKey f t =
-  maybe
-    t
-    ( \(k, a) ->
-        maybe
-          (delete k t)
-          (\a' -> insert k a' t)
-          $ f k a
-    )
-    $ lookupMax t
-
--- | /O(log n)/ Modify the value of the minimum key or delete its bin
-updateMin :: (Ord k) => (a -> Maybe a) -> Map k a -> Map k a
-updateMin = updateMinWithKey . const
-
--- | /O(log n)/ Modify the value of the minimum key or delete its bin
-updateMinWithKey :: (Ord k) => (k -> a -> Maybe a) -> Map k a -> Map k a
-updateMinWithKey f t =
-  maybe
-    t
-    ( \(k, a) ->
-        maybe
-          (delete k t)
-          (\a' -> insert k a' t)
-          $ f k a
-    )
-    $ lookupMin t
-
-{-
- - Partition
- -}
-
--- | /O(n log n)/ Partition a map with a predicate into @(true, false)@ submaps
-partition :: (Ord k) => (a -> Bool) -> Map k a -> (Map k a, Map k a)
-partition = partitionWithKey . const
-
--- | /O(n log n)/ Partition a map with a predicate into @(true, false)@ submaps
-partitionWithKey :: (Ord k) => (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
-partitionWithKey p =
-  foldrWithKey
-    (\k a (t1, t2) -> bool (t1, insert k a t2) (insert k a t1, t2) $ p k a)
-    (empty, empty)
-
--- | /O(n log n)/ Split a map by a key into @(lt, eq, gt)@ submaps
-split :: (Ord k) => k -> Map k a -> (Map k a, Maybe a, Map k a)
-split k0 =
-  foldrWithKey
-    ( \k a (t1, a', t2) -> case compare k k0 of
-        LT -> (insert k a t1, a', t2)
-        EQ -> (t1, Just a, t2)
-        GT -> (t1, a', insert k a t2)
-    )
-    (empty, Nothing, empty)
-
--- | /O(log n)/ Split a map by its maximum key
-splitMax :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)
-splitMax t = (,deleteMax t) <$> lookupMax t
-
--- | /O(log n)/ Split a map by its minimum key
-splitMin :: (Ord k) => Map k a -> Maybe ((k, a), Map k a)
-splitMin t = (,deleteMin t) <$> lookupMin t
-
-{-
- - Query
- -}
-
--- | /O(m log n)/ Check whether two maps have no keys in common
-disjoint :: (Ord k) => Map k a -> Map k a -> Bool
-disjoint t1 = not . foldrWithKey (\k _ b -> k `member` t1 || b) False
-
--- | /O(n log m)/ Check whether the bins of one map exist in the other
-isSubmapOf :: (Ord k, Eq a) => Map k a -> Map k a -> Bool
-isSubmapOf = isSubmapOfBy (==)
-
--- | /O(n log m)/ Check if the bins of one map exist in the other by combination
-isSubmapOfBy :: (Ord k) => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
-isSubmapOfBy p t1 t2 =
-  foldrWithKey
-    (\k a b -> maybe False ((&& b) . p a) $ lookup k t2)
-    True
-    t1
-
--- | /O(log n)/ Fetch the value of a key in a map, or 'Nothing' if absent
-lookup :: (Ord k) => k -> Map k a -> Maybe a
-lookup k = map Nothing go go go
- where
-  go _ k' a _ recl recr = case compare k k' of
-    LT -> recl
-    EQ -> Just a
-    GT -> recr
-
--- | /O(log n)/ Fetch the least bin greater than or equal to a key
-lookupGE :: (Ord k) => k -> Map k a -> Maybe (k, a)
-lookupGE k0 = map Nothing go go go
- where
-  go _ k a _ recl recr = case compare k k0 of
-    LT -> recr
-    EQ -> Just (k, a)
-    GT -> recl <|> Just (k, a)
-
--- | /O(log n)/ Fetch the least bin strictly greater than a key
-lookupGT :: (Ord k) => k -> Map k a -> Maybe (k, a)
-lookupGT k0 = map Nothing go go go
- where
-  go _ k a _ recl recr = case compare k k0 of
-    LT -> recr
-    EQ -> recr
-    GT -> recl <|> Just (k, a)
-
--- | /O(log n)/ Fetch the greatest bin less than or equal to a key
-lookupLE :: (Ord k) => k -> Map k a -> Maybe (k, a)
-lookupLE k0 = map Nothing go go go
- where
-  go _ k a _ recl recr = case compare k k0 of
-    LT -> recr <|> Just (k, a)
-    EQ -> Just (k, a)
-    GT -> recl
-
--- | /O(log n)/ Fetch the greatest bin strictly less than a key
-lookupLT :: (Ord k) => k -> Map k a -> Maybe (k, a)
-lookupLT k0 = map Nothing go go go
- where
-  go _ k a _ recl recr = case compare k k0 of
-    LT -> recr <|> Just (k, a)
-    EQ -> recl
-    GT -> recl
-
--- | /O(log n)/ Fetch the bin with the maximum key, or 'Nothing' if empty
-lookupMax :: Map k a -> Maybe (k, a)
-lookupMax = map Nothing go go go
- where
-  go _ k a r _ recr = map (Just (k, a)) go' go' go' r
-   where
-    go' _ _ _ _ _ _ = recr
-
--- | /O(log n)/ Fetch the bin with the minimum key, or 'Nothing' if empty
-lookupMin :: Map k a -> Maybe (k, a)
-lookupMin = map Nothing go go go
- where
-  go l k a _ recl _ = map (Just (k, a)) go' go' go' l
-   where
-    go' _ _ _ _ _ _ = recl
-
--- | /O(log n)/ Check whether a key is in a map
-member :: (Ord k) => k -> Map k a -> Bool
-member k0 = map False go go go
- where
-  go _ k _ _ recl recr = case compare k0 k of
-    LT -> recl
-    EQ -> True
-    GT -> recr
-
--- | /O(1)/ Check whether a map is empty
-null :: Map k a -> Bool
-null = map True go go go where go _ _ _ _ _ _ = False
-
--- | /O(n)/ Get the size of a map
-size :: Map k a -> Int
-size = map 0 go go go where go _ _ _ _ recl recr = 1 + recl + recr
-
-{-
- - Traversal
- -}
-
--- | /O(n)/ Apply an operation across a map, transforming its values
-fmapWithKey :: (k -> a -> b) -> Map k a -> Map k b
-fmapWithKey f = map E (go L) (go B) (go R)
- where
-  go c _ k a _ recl = c recl k (f k a)
-
--- | /O(n)/ Lift a map with a lifting operation on keys and values
-traverseWithKey :: (Applicative f) => (k -> a -> f b) -> Map k a -> f (Map k b)
-traverseWithKey f = map (pure E) (go L) (go B) (go R)
- where
-  go c _ k a _ recl recr = c <$> recl <*> pure k <*> f k a <*> recr
-
-{-
- - Validation
- -}
-
--- | /O(n)/ Check whether a map is internally height-balanced and ordered
-valid :: (Ord k) => Map k a -> Bool
-valid = liftA2 (&&) balanced ordered
- where
-  balanced =
-    map
-      True
-      (\l _ _ r recl recr -> levels l - levels r == 1 && recl && recr)
-      (\l _ _ r recl recr -> levels l - levels r == 0 && recl && recr)
-      (\l _ _ r recl recr -> levels r - levels l == 1 && recl && recr)
-  levels = map 0 go go go
-   where
-    go _ _ _ _ recl recr = 1 + max recl recr :: Int
-  ordered = map True go go go
-   where
-    go l k _ r recl recr =
-      map True lt lt lt l
-        && map True gt gt gt r
-     where
-      lt _ lk _ _ _ _ = lk < k && recl && recr
-      gt _ rk _ _ _ _ = rk > k && recl && recr
 
 {-
  - Examples
diff --git a/Mini/Data/Set.hs b/Mini/Data/Set.hs
--- a/Mini/Data/Set.hs
+++ b/Mini/Data/Set.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE TupleSections #-}
+-- incomplete patterns in 'from{Asc,Desc}List'
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 -- | A structure containing unique elements
 module Mini.Data.Set (
@@ -7,8 +9,12 @@
 
   -- * Construction
   empty,
-  fromList,
   singleton,
+  fromList,
+  fromAscList,
+  fromDescList,
+  fromDistinctAscList,
+  fromDistinctDescList,
 
   -- * Combination
   difference,
@@ -55,11 +61,16 @@
   (<|>),
  )
 import Data.Bifunctor (
+  bimap,
   first,
+  second,
  )
 import Data.Bool (
   bool,
  )
+import Data.Function (
+  on,
+ )
 import Prelude (
   Bool (
     False,
@@ -81,25 +92,32 @@
   ),
   Semigroup,
   Show,
+  all,
   any,
   compare,
+  div,
   error,
   flip,
   foldl,
   foldr,
+  length,
   max,
   maybe,
   mempty,
   not,
   show,
+  splitAt,
   uncurry,
+  until,
   ($),
   (&&),
+  (*),
   (+),
   (-),
   (.),
   (<),
   (<$>),
+  (<*>),
   (<>),
   (==),
   (>),
@@ -121,10 +139,10 @@
     R (Set a) a (Set a)
 
 instance (Eq a) => Eq (Set a) where
-  t1 == t2 = toAscList t1 == toAscList t2
+  (==) = (==) `on` toAscList
 
 instance (Ord a) => Ord (Set a) where
-  compare t1 t2 = compare (toAscList t1) (toAscList t2)
+  compare = compare `on` toAscList
 
 instance (Show a) => Show (Set a) where
   show = show . toAscList
@@ -170,33 +188,74 @@
 empty :: Set a
 empty = E
 
+-- | /O(1)/ Make a set with a single element
+singleton :: a -> Set a
+singleton a = B E a E
+
 -- | /O(n log n)/ Make a set from a list of elements
 fromList :: (Ord a) => [a] -> Set a
 fromList = foldl (flip insert) empty
 
--- | /O(1)/ Make a set with a single element
-singleton :: a -> Set a
-singleton a = B E a E
+-- | /O(n)/ Make a set from a sorted list of elements
+fromAscList :: (Eq a) => [a] -> Set a
+fromAscList = fromDistinctAscList . essence
 
+-- | /O(n)/ Make a set from a sorted list of elements
+fromDescList :: (Eq a) => [a] -> Set a
+fromDescList = fromDistinctDescList . essence
+
+-- | /O(n)/ Make a set from a sorted list of distinct elements
+fromDistinctAscList :: [a] -> Set a
+fromDistinctAscList = go <*> power
+ where
+  go [] _ = E
+  go [a] _ = B E a E
+  go as n =
+    let len = length as
+        n' = n `div` 2
+        c = bool B L $ len == n
+        (l, a : r) = splitAt (len `div` 2) as
+     in c (go l n') a (go r n')
+
+-- | /O(n)/ Make a set from a sorted list of distinct elements
+fromDistinctDescList :: [a] -> Set a
+fromDistinctDescList = go <*> power
+ where
+  go [] _ = E
+  go [a] _ = B E a E
+  go as n =
+    let len = length as
+        n' = n `div` 2
+        c = bool B R $ len == n
+        (l, a : r) = splitAt (len `div` 2) as
+     in c (go r n') a (go l n')
+
 {-
  - Combination
  -}
 
 -- | /O(m log n)/ Subtract a set by another
 difference :: (Ord a) => Set a -> Set a -> Set a
-difference = foldr delete
+difference t1 t2 = set empty go go go t1
+ where
+  go _ _ _ _ _ = foldr delete t1 t2
 
 -- | /O(m log n)/ Intersect a set with another
 intersection :: (Ord a) => Set a -> Set a -> Set a
-intersection t1 t2 =
-  foldr
-    (\a b -> bool b (insert a b) (a `member` t2))
-    empty
-    t1
+intersection t1 t2 = set empty go go go t2
+ where
+  go _ _ _ _ _ =
+    fromDistinctAscList $
+      foldr
+        (\a b -> bool b (a : b) $ a `member` t2)
+        []
+        t1
 
 -- | /O(m log n)/ Unite a set with another
 union :: (Ord a) => Set a -> Set a -> Set a
-union = flip $ foldr insert
+union t1 t2 = set t2 go go go t1
+ where
+  go _ _ _ _ _ = foldr insert t1 t2
 
 -- | Unite a collection of sets
 unions :: (Foldable t, Ord a) => t (Set a) -> Set a
@@ -220,29 +279,214 @@
 
 -- | /O(log n)/ Delete an element from a set
 delete :: (Ord a) => a -> Set a -> Set a
-delete a0 t = bool t (go t) (a0 `member` t)
+delete a t = bool t (delete' a t) $ a `member` t
+
+-- | /O(log n)/ Delete the maximum element from a set
+deleteMax :: (Ord a) => Set a -> Set a
+deleteMax t = maybe t (`delete'` t) $ lookupMax t
+
+-- | /O(log n)/ Delete the minimum element from a set
+deleteMin :: (Ord a) => Set a -> Set a
+deleteMin t = maybe t (`delete'` t) $ lookupMin t
+
+-- | /O(n)/ Keep the elements satisfying a predicate
+filter :: (a -> Bool) -> Set a -> Set a
+filter p = fromDistinctAscList . foldr (\a b -> bool b (a : b) $ p a) []
+
+-- | /O(log n)/ Insert an element into a set
+insert :: (Ord a) => a -> Set a -> Set a
+insert a t = bool (insert' a t) t $ a `member` t
+
+{-
+ - Partition
+ -}
+
+-- | /O(n)/ Partition a set with a predicate into @(true, false)@ subsets
+partition :: (a -> Bool) -> Set a -> (Set a, Set a)
+partition p =
+  bimap fromDistinctAscList fromDistinctAscList
+    . foldr
+      (\a -> bool second first (p a) (a :))
+      ([], [])
+
+-- | /O(n)/ Split a set by an element into @(lt, eq, gt)@ subsets
+split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)
+split a0 =
+  (\(lt, a, gt) -> (fromDistinctAscList lt, a, fromDistinctAscList gt))
+    . foldr
+      ( \a (lt, a', gt) -> case compare a a0 of
+          LT -> (a : lt, a', gt)
+          EQ -> (lt, True, gt)
+          GT -> (lt, a', a : gt)
+      )
+      ([], False, [])
+
+-- | /O(log n)/ Split a set by its maximum element
+splitMax :: (Ord a) => Set a -> Maybe (a, Set a)
+splitMax t = ((,) <*> flip delete' t) <$> lookupMax t
+
+-- | /O(log n)/ Split a set by its minimum element
+splitMin :: (Ord a) => Set a -> Maybe (a, Set a)
+splitMin t = ((,) <*> flip delete' t) <$> lookupMin t
+
+{-
+ - Query
+ -}
+
+-- | /O(m log n)/ Check whether two sets have no elements in common
+disjoint :: (Ord a) => Set a -> Set a -> Bool
+disjoint t1 t2 = set True go go go t1
  where
-  go =
+  go _ _ _ _ _ = not $ any (`member` t1) t2
+
+-- | /O(n log m)/ Check whether the elements of a set exist in the other
+isSubsetOf :: (Ord a) => Set a -> Set a -> Bool
+isSubsetOf t1 t2 = set (null t1) go go go t2
+ where
+  go _ _ _ _ _ = all (`member` t2) t1
+
+-- | /O(log n)/ Fetch the least element greater than or equal to the given one
+lookupGE :: (Ord a) => a -> Set a -> Maybe a
+lookupGE a0 = set Nothing go go go
+ where
+  go _ a _ recl recr = case compare a a0 of
+    LT -> recr
+    EQ -> Just a
+    GT -> recl <|> Just a
+
+-- | /O(log n)/ Fetch the least element strictly greater than the given one
+lookupGT :: (Ord a) => a -> Set a -> Maybe a
+lookupGT a0 = set Nothing go go go
+ where
+  go _ a _ recl recr = case compare a a0 of
+    LT -> recr
+    EQ -> recr
+    GT -> recl <|> Just a
+
+-- | /O(log n)/ Fetch the greatest element less than or equal to the given one
+lookupLE :: (Ord a) => a -> Set a -> Maybe a
+lookupLE a0 = set Nothing go go go
+ where
+  go _ a _ recl recr = case compare a a0 of
+    LT -> recr <|> Just a
+    EQ -> Just a
+    GT -> recl
+
+-- | /O(log n)/ Fetch the greatest element strictly less than the given one
+lookupLT :: (Ord a) => a -> Set a -> Maybe a
+lookupLT a0 = set Nothing go go go
+ where
+  go _ a _ recl recr = case compare a a0 of
+    LT -> recr <|> Just a
+    EQ -> recl
+    GT -> recl
+
+-- | /O(log n)/ Fetch the maximum element, or 'Nothing' if the set is empty
+lookupMax :: Set a -> Maybe a
+lookupMax = set Nothing go go go
+ where
+  go _ a r _ recr = set (Just a) go' go' go' r
+   where
+    go' _ _ _ _ _ = recr
+
+-- | /O(log n)/ Fetch the minimum element, or 'Nothing' if the set is empty
+lookupMin :: Set a -> Maybe a
+lookupMin = set Nothing go go go
+ where
+  go l a _ recl _ = set (Just a) go' go' go' l
+   where
+    go' _ _ _ _ _ = recl
+
+-- | /O(log n)/ Check whether an element is in a set
+member :: (Ord a) => a -> Set a -> Bool
+member a0 = set False go go go
+ where
+  go _ a _ recl recr = case compare a0 a of
+    LT -> recl
+    EQ -> True
+    GT -> recr
+
+-- | /O(1)/ Check whether a set is empty
+null :: Set a -> Bool
+null = set True go go go where go _ _ _ _ _ = False
+
+-- | /O(n)/ Get the size of a set
+size :: Set a -> Int
+size = set 0 go go go where go _ _ _ recl recr = 1 + recl + recr
+
+{-
+ - Validation
+ -}
+
+-- | /O(n^2)/ Check whether a set is internally height-balanced and ordered
+valid :: (Ord a) => Set a -> Bool
+valid = liftA2 (&&) balanced ordered
+ where
+  balanced =
     set
-      (error "Set.delete: L0")
-      ( \l a r _ _ ->
-          case compare a0 a of
-            LT -> deleteLl l a r
-            EQ -> substituteL l r
-            GT -> deleteLr l a r
-      )
-      ( \l a r _ _ ->
-          case compare a0 a of
-            LT -> deleteBl l a r
-            EQ -> substituteBr l r
-            GT -> deleteBr l a r
-      )
-      ( \l a r _ _ ->
-          case compare a0 a of
-            LT -> deleteRl l a r
-            EQ -> substituteR l r
-            GT -> deleteRr l a r
-      )
+      True
+      (\l _ r recl recr -> levels l - levels r == 1 && recl && recr)
+      (\l _ r recl recr -> levels l - levels r == 0 && recl && recr)
+      (\l _ r recl recr -> levels r - levels l == 1 && recl && recr)
+  levels = set 0 go go go
+   where
+    go _ _ _ recl recr = 1 + max recl recr :: Int
+  ordered = set True go go go
+   where
+    go l a r recl recr =
+      set True lt lt lt l
+        && set True gt gt gt r
+     where
+      lt _ la _ _ _ = la < a && recl && recr
+      gt _ ra _ _ _ = ra > a && recl && recr
+
+{-
+ - Helpers
+ -}
+
+-- O(n) 'nub' for sorted lists
+essence :: (Eq a) => [a] -> [a]
+essence [] = []
+essence (a : as) = essence' a as
+ where
+  essence' x1 [] = [x1]
+  essence' x1 (x2 : xs) =
+    let rest = essence' x2 xs
+     in bool (x1 : rest) rest $ x1 == x2
+
+-- The greatest power of 2 <= the length of a non-empty collection
+power :: (Foldable t) => t a -> Int
+power as = until (> length as) (* 2) 2 `div` 2
+
+{-
+ - Let this comment serve as your warning. Return from whence you came and your
+ - sanity will be spared. You have been admonished.
+ -}
+
+-- O(log n) Delete an element from a set without checking for membership
+delete' :: (Ord a) => a -> Set a -> Set a
+delete' a0 =
+  set
+    (error "Set.delete: L0")
+    ( \l a r _ _ ->
+        case compare a0 a of
+          LT -> deleteLl l a r
+          EQ -> substituteL l r
+          GT -> deleteLr l a r
+    )
+    ( \l a r _ _ ->
+        case compare a0 a of
+          LT -> deleteBl l a r
+          EQ -> substituteBr l r
+          GT -> deleteBr l a r
+    )
+    ( \l a r _ _ ->
+        case compare a0 a of
+          LT -> deleteRl l a r
+          EQ -> substituteR l r
+          GT -> deleteRr l a r
+    )
+ where
   deleteRl l a r =
     set
       (error "Set.delete: L1")
@@ -635,21 +879,9 @@
   popRightBR l a rl ra rr = first (checkRightB l a) $ popRightR rl ra rr
   popRightBL l a rl ra rr = first (checkRightB l a) $ popRightL rl ra rr
 
--- | /O(log n)/ Delete the maximum element from a set
-deleteMax :: (Ord a) => Set a -> Set a
-deleteMax t = maybe t (`delete` t) $ lookupMax t
-
--- | /O(log n)/ Delete the minimum element from a set
-deleteMin :: (Ord a) => Set a -> Set a
-deleteMin t = maybe t (`delete` t) $ lookupMin t
-
--- | /O(n log n)/ Keep the elements satisfying a predicate
-filter :: (Ord a) => (a -> Bool) -> Set a -> Set a
-filter p = foldr (\a b -> bool b (insert a b) $ p a) empty
-
--- | /O(log n)/ Insert an element into a set
-insert :: (Ord a) => a -> Set a -> Set a
-insert a0 =
+-- O(log n) Insert an element into a set without checking for membership
+insert' :: (Ord a) => a -> Set a -> Set a
+insert' a0 =
   set
     (B E a0 E)
     (\l a r _ _ -> insertL l a r)
@@ -811,140 +1043,3 @@
       )
       (\lrl lra lrr _ _ -> L (B ll la (insertR lrl lra lrr)) a r)
       lr
-
-{-
- - Partition
- -}
-
--- | /O(n log n)/ Partition a set with a predicate into @(true, false)@ subsets
-partition :: (Ord a) => (a -> Bool) -> Set a -> (Set a, Set a)
-partition p =
-  foldr
-    (\a (t1, t2) -> bool (t1, insert a t2) (insert a t1, t2) $ p a)
-    (empty, empty)
-
--- | /O(n log n)/ Split a set by an element into @(lt, eq, gt)@ subsets
-split :: (Ord a) => a -> Set a -> (Set a, Bool, Set a)
-split a0 =
-  foldr
-    ( \a (t1, a', t2) -> case compare a a0 of
-        LT -> (insert a t1, a', t2)
-        EQ -> (t1, True, t2)
-        GT -> (t1, a', insert a t2)
-    )
-    (empty, False, empty)
-
--- | /O(log n)/ Split a set by its maximum element
-splitMax :: (Ord a) => Set a -> Maybe (a, Set a)
-splitMax t = (,deleteMax t) <$> lookupMax t
-
--- | /O(log n)/ Split a set by its minimum element
-splitMin :: (Ord a) => Set a -> Maybe (a, Set a)
-splitMin t = (,deleteMin t) <$> lookupMin t
-
-{-
- - Query
- -}
-
--- | /O(m log n)/ Check whether two sets have no elements in common
-disjoint :: (Ord a) => Set a -> Set a -> Bool
-disjoint t1 = not . any (`member` t1)
-
--- | /O(n log m)/ Check whether the elements of a set exist in the other
-isSubsetOf :: (Ord a) => Set a -> Set a -> Bool
-isSubsetOf t1 t2 = foldr (\a b -> a `member` t2 && b) True t1
-
--- | /O(log n)/ Fetch the least element greater than or equal to the given one
-lookupGE :: (Ord a) => a -> Set a -> Maybe a
-lookupGE a0 = set Nothing go go go
- where
-  go _ a _ recl recr = case compare a a0 of
-    LT -> recr
-    EQ -> Just a
-    GT -> recl <|> Just a
-
--- | /O(log n)/ Fetch the least element strictly greater than the given one
-lookupGT :: (Ord a) => a -> Set a -> Maybe a
-lookupGT a0 = set Nothing go go go
- where
-  go _ a _ recl recr = case compare a a0 of
-    LT -> recr
-    EQ -> recr
-    GT -> recl <|> Just a
-
--- | /O(log n)/ Fetch the greatest element less than or equal to the given one
-lookupLE :: (Ord a) => a -> Set a -> Maybe a
-lookupLE a0 = set Nothing go go go
- where
-  go _ a _ recl recr = case compare a a0 of
-    LT -> recr <|> Just a
-    EQ -> Just a
-    GT -> recl
-
--- | /O(log n)/ Fetch the greatest element strictly less than the given one
-lookupLT :: (Ord a) => a -> Set a -> Maybe a
-lookupLT a0 = set Nothing go go go
- where
-  go _ a _ recl recr = case compare a a0 of
-    LT -> recr <|> Just a
-    EQ -> recl
-    GT -> recl
-
--- | /O(log n)/ Fetch the maximum element, or 'Nothing' if the set is empty
-lookupMax :: Set a -> Maybe a
-lookupMax = set Nothing go go go
- where
-  go _ a r _ recr = set (Just a) go' go' go' r
-   where
-    go' _ _ _ _ _ = recr
-
--- | /O(log n)/ Fetch the minimum element, or 'Nothing' if the set is empty
-lookupMin :: Set a -> Maybe a
-lookupMin = set Nothing go go go
- where
-  go l a _ recl _ = set (Just a) go' go' go' l
-   where
-    go' _ _ _ _ _ = recl
-
--- | /O(log n)/ Check whether an element is in a set
-member :: (Ord a) => a -> Set a -> Bool
-member a0 = set False go go go
- where
-  go _ a _ recl recr = case compare a0 a of
-    LT -> recl
-    EQ -> True
-    GT -> recr
-
--- | /O(1)/ Check whether a set is empty
-null :: Set a -> Bool
-null = set True go go go where go _ _ _ _ _ = False
-
--- | /O(n)/ Get the size of a set
-size :: Set a -> Int
-size = set 0 go go go where go _ _ _ recl recr = 1 + recl + recr
-
-{-
- - Validation
- -}
-
--- | /O(n)/ Check whether a set is internally height-balanced and ordered
-valid :: (Ord a) => Set a -> Bool
-valid = liftA2 (&&) balanced ordered
- where
-  balanced =
-    set
-      True
-      (\l _ r recl recr -> levels l - levels r == 1 && recl && recr)
-      (\l _ r recl recr -> levels l - levels r == 0 && recl && recr)
-      (\l _ r recl recr -> levels r - levels l == 1 && recl && recr)
-  levels = set 0 go go go
-   where
-    go _ _ _ recl recr = 1 + max recl recr :: Int
-  ordered = set True go go go
-   where
-    go l a r recl recr =
-      set True lt lt lt l
-        && set True gt gt gt r
-     where
-      lt _ la _ _ _ = la < a && recl && recr
-      gt _ ra _ _ _ = ra > a && recl && recr
diff --git a/mini.cabal b/mini.cabal
--- a/mini.cabal
+++ b/mini.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               mini
-version:            1.5.3.0
+version:            1.5.4.0
 license:            MIT
 license-file:       LICENSE
 author:             Victor Wallsten <victor.wallsten@protonmail.com>