Use NonEmpty in intersections (#1052)

Using Foldable1 requires a conditional export at the moment which we want to avoid, going by the PVP FAQ. We can use Foldable1 once it is available is all base versions we support.
haskell · Oct 23, 2024 · 5942d91 · 5942d91
1 parent e8dbba8
commit 5942d91
Show file tree

Hide file tree

Showing 6 changed files with 17 additions and 51 deletions.
diff --git a/containers-tests/tests/intset-properties.hs b/containers-tests/tests/intset-properties.hs
@@ -7,11 +7,8 @@ import Data.List (nub,sort)
 import qualified Data.List as List
 import Data.Maybe (listToMaybe)
 import Data.Monoid (mempty)
-#if MIN_VERSION_base(4,18,0)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
-import qualified Data.Foldable1 as Foldable1
-#endif
 import qualified Data.Set as Set
 import IntSetValidity (valid)
 import Prelude hiding (lookup, null, map, filter, foldr, foldl, foldl', foldMap)
@@ -88,10 +85,8 @@ main = defaultMain $ testGroup "intset-properties"
                    , testProperty "prop_bitcount" prop_bitcount
                    , testProperty "prop_alterF_list" prop_alterF_list
                    , testProperty "prop_alterF_const" prop_alterF_const
-#if MIN_VERSION_base(4,18,0)
                    , testProperty "intersections" prop_intersections
                    , testProperty "intersections_lazy" prop_intersections_lazy
-#endif
                    ]
 
 ----------------------------------------------------------------
@@ -514,17 +509,15 @@ prop_alterF_const f k s =
         getConst (alterF     (Const . applyFun f) k s        )
     === getConst (Set.alterF (Const . applyFun f) k (toSet s))
 
-#if MIN_VERSION_base(4,18,0)
 prop_intersections :: (IntSet, [IntSet]) -> Property
 prop_intersections (s, ss) =
-  intersections ss' === Foldable1.foldl1' intersection ss'
+  intersections ss' === List.foldl' intersection s ss
   where
     ss' = s :| ss -- Work around missing Arbitrary NonEmpty instance
 
 prop_intersections_lazy :: [IntSet] -> Property
 prop_intersections_lazy ss = intersections ss' === empty
   where
-    ss' = NE.fromList $ ss ++ [empty] ++ undefined
-                            -- ^ result will certainly be empty at this point,
-                            --   so the rest of the list should not be demanded.
-#endif
+    ss' = NE.fromList $ ss ++ [empty] ++ error "too strict"
+                           --- ^ result will certainly be empty at this point,
+                           --    so the rest of the list should not be demanded.
diff --git a/containers-tests/tests/set-properties.hs b/containers-tests/tests/set-properties.hs
@@ -16,11 +16,8 @@ import Control.Monad (liftM, liftM3)
 import Data.Functor.Identity
 import Data.Foldable (all)
 import Control.Applicative (liftA2)
-#if MIN_VERSION_base(4,18,0)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
-import qualified Data.Foldable1 as Foldable1
-#endif
 
 #if __GLASGOW_HASKELL__ >= 806
 import Utils.NoThunks (whnfHasNoThunks)
@@ -117,10 +114,8 @@ main = defaultMain $ testGroup "set-properties"
 #endif
                    , testProperty "eq" prop_eq
                    , testProperty "compare" prop_compare
-#if MIN_VERSION_base(4,18,0)
                    , testProperty "intersections" prop_intersections
                    , testProperty "intersections_lazy" prop_intersections_lazy
-#endif
                    ]
 
 -- A type with a peculiar Eq instance designed to make sure keys
@@ -748,17 +743,15 @@ prop_eq s1 s2 = (s1 == s2) === (toList s1 == toList s2)
 prop_compare :: Set Int -> Set Int -> Property
 prop_compare s1 s2 = compare s1 s2 === compare (toList s1) (toList s2)
 
-#if MIN_VERSION_base(4,18,0)
 prop_intersections :: (Set Int, [Set Int]) -> Property
 prop_intersections (s, ss) =
-  intersections ss' === Foldable1.foldl1' intersection ss'
+  intersections ss' === List.foldl' intersection s ss
   where
     ss' = s :| ss -- Work around missing Arbitrary NonEmpty instance
 
 prop_intersections_lazy :: [Set Int] -> Property
 prop_intersections_lazy ss = intersections ss' === empty
   where
-    ss' = NE.fromList $ ss ++ [empty] ++ undefined
-                            -- ^ result will certainly be empty at this point,
-                            --   so the rest of the list should not be demanded.
-#endif
+    ss' = NE.fromList $ ss ++ [empty] ++ error "too strict"
+                           --- ^ result will certainly be empty at this point,
+                           --    so the rest of the list should not be demanded.
diff --git a/containers/src/Data/IntSet.hs b/containers/src/Data/IntSet.hs
@@ -109,9 +109,7 @@ module Data.IntSet (
             , difference
             , (\\)
             , intersection
-#if MIN_VERSION_base(4,18,0)
             , intersections
-#endif
             , symmetricDifference
             , Intersection(..)
 

diff --git a/containers/src/Data/IntSet/Internal.hs b/containers/src/Data/IntSet/Internal.hs
@@ -125,9 +125,7 @@ module Data.IntSet.Internal (
     , unions
     , difference
     , intersection
-#if MIN_VERSION_base(4,18,0)
     , intersections
-#endif
     , symmetricDifference
     , Intersection(..)
 
@@ -196,16 +194,13 @@ import Control.Applicative (Const(..))
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits
 import qualified Data.List as List
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (fromMaybe)
 import Data.Semigroup
   (Semigroup(stimes), stimesIdempotent, stimesIdempotentMonoid)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Semigroup (Semigroup((<>)))
 #endif
-#if MIN_VERSION_base(4,18,0)
-import qualified Data.Foldable1 as Foldable1
-import Data.List.NonEmpty (NonEmpty(..))
-#endif
 import Utils.Containers.Internal.Prelude hiding
   (filter, foldr, foldl, foldl', foldMap, null, map)
 import Prelude ()
@@ -671,24 +666,21 @@ intersection (Tip kx1 bm1) t2 = intersectBM t2
 
 intersection Nil _ = Nil
 
-#if MIN_VERSION_base(4,18,0)
 -- | The intersection of a series of sets. Intersections are performed
 -- left-to-right.
 --
 -- @since FIXME
-intersections :: Foldable1.Foldable1 f => f IntSet -> IntSet
-intersections ss = case Foldable1.toNonEmpty ss of
-  s0 :| ss'
-    | null s0 -> empty
-    | otherwise -> List.foldr go id ss' s0
+intersections :: NonEmpty IntSet -> IntSet
+intersections (s0 :| ss)
+  | null s0 = empty
+  | otherwise = List.foldr go id ss s0
   where
     go s r acc
       | null acc' = empty
       | otherwise = r acc'
       where
         acc' = intersection acc s
 {-# INLINABLE intersections #-}
-#endif
 
 -- | @IntSet@s form a 'Semigroup' under 'intersection'.
 --

diff --git a/containers/src/Data/Set.hs b/containers/src/Data/Set.hs
@@ -117,9 +117,7 @@ module Data.Set (
             , difference
             , (\\)
             , intersection
-#if MIN_VERSION_base(4,18,0)
             , intersections
-#endif
             , symmetricDifference
             , cartesianProduct
             , disjointUnion

diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
@@ -155,9 +155,7 @@ module Data.Set.Internal (
             , unions
             , difference
             , intersection
-#if MIN_VERSION_base(4,18,0)
             , intersections
-#endif
             , symmetricDifference
             , cartesianProduct
             , disjointUnion
@@ -250,10 +248,7 @@ import Data.Functor.Classes
 import Data.Functor.Identity (Identity)
 import qualified Data.Foldable as Foldable
 import Control.DeepSeq (NFData(rnf))
-#if MIN_VERSION_base(4,18,0)
-import qualified Data.Foldable1 as Foldable1
 import Data.List.NonEmpty (NonEmpty(..))
-#endif
 
 import Utils.Containers.Internal.StrictPair
 import Utils.Containers.Internal.PtrEquality
@@ -904,24 +899,21 @@ intersection t1@(Bin _ x l1 r1) t2
 {-# INLINABLE intersection #-}
 #endif
 
-#if MIN_VERSION_base(4,18,0)
 -- | The intersection of a series of sets. Intersections are performed
 -- left-to-right.
 --
 -- @since FIXME
-intersections :: (Foldable1.Foldable1 f, Ord a) => f (Set a) -> Set a
-intersections ss = case Foldable1.toNonEmpty ss of
-  s0 :| ss'
-    | null s0 -> empty
-    | otherwise -> List.foldr go id ss' s0
+intersections :: Ord a => NonEmpty (Set a) -> Set a
+intersections (s0 :| ss)
+  | null s0 = empty
+  | otherwise = List.foldr go id ss s0
   where
     go s r acc
       | null acc' = empty
       | otherwise = r acc'
       where
         acc' = intersection acc s
 {-# INLINABLE intersections #-}
-#endif
 
 -- | @Set@s form a 'Semigroup' under 'intersection'.
 --