Support containers-0.8. (#18)

* Make `combineEq` match bias of `Set.from{Asc,Desc}List`.

This commit provides a workaround for a change in the behaviour of
`Set.from{Asc,Desc}List` w.r.t. duplicate elements, when upgrading
from `containers-0.7` to `containers-0.8`.

We can use the `K` type from `Tests.Util` to demonstrate this.

With `containers-0.7`, `Set.from{Asc,Desc}List` chooses the **_first_**
occurrence of any duplicated element:

```hs
$ cabal repl nonempty-containers-test --constraint=containers==0.7
> import qualified Data.Set as Set
> import Tests.Util
> Set.fromAscList [K 'a' 1, K 'a' 2]
fromList [K {getKX = 'a', getKY = 1}]
> Set.fromDescList [K 'a' 1, K 'a' 2]
fromList [K {getKX = 'a', getKY = 1}]
```

With `containers-0.8`, `Set.from{Asc,Desc}List` chooses the **_last_**
occurrence of any duplicated element:

```hs
$ cabal repl nonempty-containers-test --constraint=containers==0.8
> import qualified Data.Set as Set
> import Tests.Util
> Set.fromAscList [K 'a' 1, K 'a' 2]
fromList [K {getKX = 'a', getKY = 2}]
> Set.fromDescList [K 'a' 1, K 'a' 2]
fromList [K {getKX = 'a', getKY = 2}]
```

This commit adjusts the bias of `Data.Set.NonEmpty.combineEq` to match
the bias of `Set.from{Asc,Desc}List` in the version of `containers`
being linked against.

* Uncomment tests for `IntMap` traversal functions.

* Fix traversal order of `traverseMapWithKey`.

The current definition of `traverseMapWithKey` does not traverse keys in
ascending order:

```hs
> import qualified Data.IntMap as IM
> import qualified Data.IntMap.NonEmpty.Internal as NEIM
> kvs = [(i, i) | i <- [-2 .. 2]]
> () <$ IM.traverseWithKey (curry print) (IM.fromList kvs)
(-2,-2)
(-1,-1)
(0,0)
(1,1)
(2,2)
> () <$ NEIM.traverseMapWithKey (curry print) (IM.fromList kvs)
(-2,-2)
(-1,-1)
(2,2)
(1,1)
(0,0)
```

As a result, traversal functions for `Data.IntMap.NonEmpty` also do not
traverse keys in ascending order.

This commit redefines `traverseMapWithKey` to be a simple synonym of
`Data.IntMap.traverseWithKey`.

With this change, the test suite passes for all versions of containers
from `0.6.3.1` up to `0.8` inclusively:

- `0.6.3.1`
- `0.6.4.1`
- `0.6.5.1`
- `0.6.6`
- `0.6.7`
- `0.6.8`
- `0.7`
- `0.8`

* Inline definition of `traverseMapWithKey`.

Since `traverseMapWithKey` is now a synonym of `IntMap.traverseWithKey`,
we can inline its definition at all call sites.

* Update bounds for `containers`.

The lower bound of `0.6.3.1` is the earliest version for which all tests
pass. This version of `containers` was released on 2020-07-14.

This commit excludes older versions of `containers` up to and including
version `0.6.2.1`, which was released on 2019-06-24.

* Remove compatibility code for `containers < 0.5.11`.

If the package itself is only buildable for `containers >= 0.6.3.1`,
then this code is no longer reachable, and thus can be removed.

* Inline compatibility functions.

These functions are now just synonyms, so they can be safely inlined.

Author: jonathanknowles

nonempty-containers.cabal

@@ -54,7 +54,7 @@ library
       aeson
     , base             >=4.9   && <5
     , comonad
-    , containers       >=0.5.9
+    , containers       >=0.6.3.1 && <0.9
     , deepseq
     , invariant
     , nonempty-vector
@@ -84,7 +84,7 @@ test-suite nonempty-containers-test
   build-depends:
       base                 >=4.9   && <5
     , comonad
-    , containers           >=0.5.9
+    , containers           >=0.6.3.1 && <0.9
     , hedgehog             >=1.0
     , hedgehog-fn          >=1.0
     , invariant

src/Data/IntMap/NonEmpty.hs

@@ -968,7 +968,7 @@ lookupLT k (NEIntMap k0 v m) = case compare k k0 of
 lookupGT :: Key -> NEIntMap a -> Maybe (Key, a)
 lookupGT k (NEIntMap k0 v m) = case compare k k0 of
   LT -> Just (k0, v)
-  EQ -> lookupMinMap m
+  EQ -> M.lookupMin m
   GT -> M.lookupGT k m
 {-# INLINE lookupGT #-}
 
@@ -1802,7 +1802,7 @@ findMin (NEIntMap k v _) = (k, v)
 --
 -- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a")
 findMax :: NEIntMap a -> (Key, a)
-findMax (NEIntMap k v m) = fromMaybe (k, v) . lookupMaxMap $ m
+findMax (NEIntMap k v m) = fromMaybe (k, v) . M.lookupMax $ m
 {-# INLINE findMax #-}
 
 -- | /O(1)/. Delete the minimal key. Returns a potentially empty map

src/Data/IntMap/NonEmpty/Internal.hs

@@ -46,18 +46,13 @@ module Data.IntMap.NonEmpty.Internal (
   traverseWithKey,
   traverseWithKey1,
   foldMapWithKey,
-  traverseMapWithKey,
 
   -- * Unsafe IntMap Functions
   insertMinMap,
   insertMaxMap,
 
   -- * Debug
   valid,
-
-  -- * CPP compatibility
-  lookupMinMap,
-  lookupMaxMap,
 ) where
 
 import Control.Applicative
@@ -409,7 +404,7 @@ traverseWithKey ::
 traverseWithKey f (NEIntMap k v m0) =
   NEIntMap k
     <$> f k v
-    <*> traverseMapWithKey f m0
+    <*> M.traverseWithKey f m0
 {-# INLINE traverseWithKey #-}
 
 -- | /O(n)/.
@@ -434,7 +429,7 @@ traverseWithKey1 f (NEIntMap k0 v m0) = case runMaybeApply m1 of
   Left m2 -> NEIntMap k0 <$> f k0 v <.> m2
   Right m2 -> flip (NEIntMap k0) m2 <$> f k0 v
   where
-    m1 = traverseMapWithKey (\k -> MaybeApply . Left . f k) m0
+    m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0
 {-# INLINEABLE traverseWithKey1 #-}
 
 -- | /O(n)/. Convert the map to a non-empty list of key\/value pairs.
@@ -712,36 +707,3 @@ insertMinMap = M.insert
 insertMaxMap :: Key -> a -> IntMap a -> IntMap a
 insertMaxMap = M.insert
 {-# INLINEABLE insertMaxMap #-}
-
--- | /O(n)/. A fixed version of 'Data.IntMap.traverseWithKey' that
--- traverses items in ascending order of keys.
-traverseMapWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
-traverseMapWithKey f = go
-  where
-    go Nil = pure Nil
-    go (Tip k v) = Tip k <$> f k v
-    go (Bin p m l r) = liftA2 (flip (Bin p m)) (go r) (go l)
-{-# INLINE traverseMapWithKey #-}
-
--- ---------------------------------------------
-
--- | CPP for new functions not in old containers
--- ---------------------------------------------
-
--- | Compatibility layer for 'Data.IntMap.Lazy.lookupMinMap'.
-lookupMinMap :: IntMap a -> Maybe (Key, a)
-#if MIN_VERSION_containers(0,5,11)
-lookupMinMap = M.lookupMin
-#else
-lookupMinMap = fmap fst . M.minViewWithKey
-#endif
-{-# INLINE lookupMinMap #-}
-
--- | Compatibility layer for 'Data.IntMap.Lazy.lookupMaxMap'.
-lookupMaxMap :: IntMap a -> Maybe (Key, a)
-#if MIN_VERSION_containers(0,5,11)
-lookupMaxMap = M.lookupMax
-#else
-lookupMaxMap = fmap fst . M.maxViewWithKey
-#endif
-{-# INLINE lookupMaxMap #-}

src/Data/IntSet/NonEmpty.hs

@@ -464,11 +464,11 @@ disjoint ::
   Bool
 disjoint n1@(NEIntSet x1 s1) n2@(NEIntSet x2 s2) = case compare x1 x2 of
   -- x1 is not in n2
-  LT -> s1 `disjointSet` toSet n2
+  LT -> s1 `S.disjoint` toSet n2
   -- k1 and k2 are a part of the result
   EQ -> False
   -- k2 is not in n1
-  GT -> toSet n1 `disjointSet` s2
+  GT -> toSet n1 `S.disjoint` s2
 {-# INLINE disjoint #-}
 
 -- | /O(m*log(n\/m + 1)), m <= n/. Difference of two sets.

src/Data/IntSet/NonEmpty/Internal.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_HADDOCK not-home #-}
@@ -29,7 +28,6 @@ module Data.IntSet.NonEmpty.Internal (
   valid,
   insertMinSet,
   insertMaxSet,
-  disjointSet,
 ) where
 
 import Control.DeepSeq
@@ -274,17 +272,3 @@ insertMinSet = S.insert
 insertMaxSet :: Key -> IntSet -> IntSet
 insertMaxSet = S.insert
 {-# INLINEABLE insertMaxSet #-}
-
--- ---------------------------------------------
-
--- | CPP for new functions not in old containers
--- ---------------------------------------------
-
--- | Comptability layer for 'Data.IntSet.disjoint'.
-disjointSet :: IntSet -> IntSet -> Bool
-#if MIN_VERSION_containers(0,5,11)
-disjointSet = S.disjoint
-#else
-disjointSet xs = S.null . S.intersection xs
-#endif
-{-# INLINE disjointSet #-}

src/Data/Sequence/NonEmpty.hs

@@ -673,7 +673,7 @@ sortBy c (x :<|| xs) =
 sortOn :: Ord b => (a -> b) -> NESeq a -> NESeq a
 sortOn f (x :<|| xs) =
   withNonEmpty (singleton x) (insertOn f x)
-    . sortOnSeq f
+    . Seq.sortOn f
     $ xs
 {-# INLINE sortOn #-}
 
@@ -721,7 +721,7 @@ unstableSortBy c = unsafeFromSeq . Seq.unstableSortBy c . toSeq
 -- TODO: figure out how to make it match 'Data.Sequence.unstableSortBy'
 -- without unsafe wrapping/unwrapping
 unstableSortOn :: Ord b => (a -> b) -> NESeq a -> NESeq a
-unstableSortOn f = unsafeFromSeq . unstableSortOnSeq f . toSeq
+unstableSortOn f = unsafeFromSeq . Seq.unstableSortOn f . toSeq
 -- unstableSortOn f (x :<|| xs) = withNonEmpty (singleton x) (insertOn f x)
 --                              . Seq.unstableSortOn f
 --                              $ xs
@@ -1051,7 +1051,7 @@ zipWith4 f (x :<|| xs) (y :<|| ys) (z :<|| zs) (r :<|| rs) = f x y z r :<|| Seq.
 -- calculating the sequence of pairs and using 'fmap' to extract each
 -- component sequence.
 unzipWith :: (a -> (b, c)) -> NESeq a -> (NESeq b, NESeq c)
-unzipWith f (x :<|| xs) = bimap (y :<||) (z :<||) . unzipWithSeq f $ xs
+unzipWith f (x :<|| xs) = bimap (y :<||) (z :<||) . Seq.unzipWith f $ xs
   where
     ~(y, z) = f x
 {-# NOINLINE [1] unzipWith #-}

src/Data/Sequence/NonEmpty/Internal.hs

@@ -42,10 +42,6 @@ module Data.Sequence.NonEmpty.Internal (
   zip,
   zipWith,
   unzip,
-  sortOnSeq,
-  unstableSortOnSeq,
-  unzipSeq,
-  unzipWithSeq,
 ) where
 
 import Control.Comonad
@@ -402,7 +398,7 @@ zipWith f (x :<|| xs) (y :<|| ys) = f x y :<|| Seq.zipWith f xs ys
 --
 -- See the note about efficiency at 'Data.Sequence.NonEmpty.unzipWith'.
 unzip :: NESeq (a, b) -> (NESeq a, NESeq b)
-unzip ((x, y) :<|| xys) = bimap (x :<||) (y :<||) . unzipSeq $ xys
+unzip ((x, y) :<|| xys) = bimap (x :<||) (y :<||) . Seq.unzip $ xys
 {-# INLINE unzip #-}
 
 instance Semigroup (NESeq a) where
@@ -572,53 +568,3 @@ mfixSeq f = fromFunction (length (f err)) (\k -> fix (\xk -> f xk `index` k))
 
 instance NFData a => NFData (NESeq a) where
   rnf (x :<|| xs) = rnf x `seq` rnf xs
-
--- ---------------------------------------------
-
--- | CPP for new functions not in old containers
--- ---------------------------------------------
-
--- | Compatibility layer for 'Data.Sequence.sortOn'.
-sortOnSeq :: Ord b => (a -> b) -> Seq a -> Seq a
-#if MIN_VERSION_containers(0,5,11)
-sortOnSeq = Seq.sortOn
-#else
-sortOnSeq f = Seq.sortBy (\x y -> f x `compare` f y)
-#endif
-{-# INLINE sortOnSeq #-}
-
--- | Compatibility layer for 'Data.Sequence.unstableSortOn'.
-unstableSortOnSeq :: Ord b => (a -> b) -> Seq a -> Seq a
-#if MIN_VERSION_containers(0,5,11)
-unstableSortOnSeq = Seq.unstableSortOn
-#else
-unstableSortOnSeq f = Seq.unstableSortBy (\x y -> f x `compare` f y)
-#endif
-{-# INLINE unstableSortOnSeq #-}
-
--- | Compatibility layer for 'Data.Sequence.unzip'.
-unzipSeq :: Seq (a, b) -> (Seq a, Seq b)
-#if MIN_VERSION_containers(0,5,11)
-unzipSeq = Seq.unzip
-{-# INLINE unzipSeq #-}
-#else
-unzipSeq = \case
-    (x, y) :<| xys -> bimap (x :<|) (y :<|) . unzipSeq $ xys
-    Empty          -> (Empty, Empty)
-{-# INLINABLE unzipSeq #-}
-#endif
-
--- | Compatibility layer for 'Data.Sequence.unzipWith'.
-unzipWithSeq :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
-#if MIN_VERSION_containers(0,5,11)
-unzipWithSeq = Seq.unzipWith
-{-# INLINE unzipWithSeq #-}
-#else
-unzipWithSeq f = go
-  where
-    go = \case
-      x :<| xs -> let ~(y, z) = f x
-                  in  bimap (y :<|) (z :<|) . go $ xs
-      Empty    -> (Empty, Empty)
-{-# INLINABLE unzipWithSeq #-}
-#endif

src/Data/Set/NonEmpty.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -337,7 +338,7 @@ powerSet (NESet x s0) = case nonEmptySet p1 of
   where
     -- powerset should never be empty
     p0 :: NESet (Set a)
-    p0@(NESet _ p0s) = forSure $ powerSetSet s0
+    p0@(NESet _ p0s) = forSure $ S.powerSet s0
     p1 :: Set (NESet a)
     p1 = S.mapMonotonic forSure p0s -- only minimal element is empty, so the rest aren't
     forSure =
@@ -462,11 +463,11 @@ disjoint ::
   Bool
 disjoint n1@(NESet x1 s1) n2@(NESet x2 s2) = case compare x1 x2 of
   -- x1 is not in n2
-  LT -> s1 `disjointSet` toSet n2
+  LT -> s1 `S.disjoint` toSet n2
   -- k1 and k2 are a part of the result
   EQ -> False
   -- k2 is not in n1
-  GT -> toSet n1 `disjointSet` s2
+  GT -> toSet n1 `S.disjoint` s2
 {-# INLINE disjoint #-}
 
 -- | /O(m*log(n\/m + 1)), m <= n/. Difference of two sets.
@@ -565,7 +566,7 @@ disjointUnion ::
 disjointUnion (NESet x1 s1) n2 =
   NESet
     (Left x1)
-    (s1 `disjointUnionSet` toSet n2)
+    (s1 `S.disjointUnion` toSet n2)
 {-# INLINE disjointUnion #-}
 
 -- | /O(n)/. Filter all elements that satisfy the predicate.
@@ -1054,5 +1055,9 @@ combineEq (x :| xs) = go x xs
   where
     go z [] = z :| []
     go z (y : ys)
+#if MIN_VERSION_containers(0,8,0)
+      | z == y = go y ys
+#else
       | z == y = go z ys
+#endif
       | otherwise = z NE.<| go y ys