Backport compareLength to Data.List{,.NonEmpty}.Compat

Towards #97.

base-compat-batteries/src/Data/List/NonEmpty/Compat.hs

@@ -15,6 +15,7 @@ module Data.List.NonEmpty.Compat (
   , sortWith
   -- * Basic functions
   , length
+  , compareLength
   , head
   , tail
   , last

base-compat/CHANGES.markdown

@@ -1,5 +1,7 @@
 ## Changes in next [????.??.??]
  - Sync with `base-4.21`/GHC 9.12
+ - Backport `compareLength` to `Data.List.Compat` and
+   `Data.List.NonEmpty.Compat`
  - Backport `inits1` and `tails1` to `Data.List.Compat`
  - Backport `firstA` and `secondA` to `Data.Bitraversable.Compat`
  - Drop support for pre-8.0 versions of GHC.

base-compat/README.markdown

@@ -136,6 +136,7 @@ So far the following is covered.
  * `dropWhileEnd`, `isSubsequenceOf`, `sortOn`, and `uncons` functions to `Data.List.Compat`
  * Correct versions of `nub`, `nubBy`, `union`, and `unionBy` to `Data.List.Compat`
  * `inits1` and `tails1` to `Data.List.Compat`
+ * `compareLength` to `Data.List.Compat` and `Data.List.NonEmpty.Compat`
  * `asProxyTypeOf` with a generalized type signature to `Data.Proxy.Compat`
  * `modifySTRef'` to `Data.STRef.Compat`
  * `String`, `lines`, `words`, `unlines`, and `unwords` to `Data.String.Compat`

base-compat/src/Data/List/Compat.hs

@@ -5,6 +5,7 @@ module Data.List.Compat (
   module Base
 
 #if !(MIN_VERSION_base(4,21,0))
+, compareLength
 , inits1
 , tails1
 #endif
@@ -29,21 +30,14 @@ module Data.List.Compat (
 
 import Data.List as Base
 
-#if !(MIN_VERSION_base(4,11,0))
-import GHC.Exts (build)
-#endif
-
-#if !(MIN_VERSION_base(4,19,0))
-import Prelude.Compat hiding (foldr, null)
-#endif
-
 #if MIN_VERSION_base(4,18,0) && !(MIN_VERSION_base(4,20,0))
 import GHC.List (List)
 #endif
 
 #if !(MIN_VERSION_base(4,21,0))
 import Data.List.NonEmpty (NonEmpty(..))
-import GHC.List (build)
+import GHC.Exts (build)
+import Prelude.Compat hiding (foldr, null)
 #endif
 
 #if !(MIN_VERSION_base(4,11,0))
@@ -145,6 +139,40 @@ unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
 #endif
 
 #if !(MIN_VERSION_base(4,21,0))
+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative
+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better
+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@.
+--
+-- While 'length' would force and traverse
+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),
+-- 'compareLength' traverses at most @n@ elements to determine its result.
+--
+-- >>> compareLength [] 0
+-- EQ
+-- >>> compareLength [] 1
+-- LT
+-- >>> compareLength ['a'] 1
+-- EQ
+-- >>> compareLength ['a', 'b'] 1
+-- GT
+-- >>> compareLength [0..] 100
+-- GT
+-- >>> compareLength undefined (-1)
+-- GT
+-- >>> compareLength ('a' : undefined) 0
+-- GT
+--
+-- @since 4.21.0.0
+--
+compareLength :: [a] -> Int -> Ordering
+compareLength xs n
+  | n < 0 = GT
+  | otherwise = foldr
+    (\_ f m -> if m > 0 then f (m - 1) else GT)
+    (\m -> if m > 0 then LT else EQ)
+    xs
+    n
+
 inits1, tails1 :: [a] -> [NonEmpty a]
 
 -- | The 'inits1' function returns all non-empty initial segments of the

base-compat/src/Data/List/NonEmpty/Compat.hs

@@ -17,6 +17,7 @@ module Data.List.NonEmpty.Compat (
   , sortWith
   -- * Basic functions
   , length
+  , compareLength
   , head
   , tail
   , last
@@ -86,10 +87,15 @@ import Data.List.NonEmpty
 import qualified Prelude.Compat as Prelude
 import Prelude.Compat ((.))
 
-import qualified Data.Foldable.Compat as Foldable
 import qualified Data.List.Compat as List
 #endif
 
+#if !(MIN_VERSION_base(4,21,0))
+import Prelude.Compat (Int, Num(..), Ord(..), Ordering(..), otherwise)
+
+import qualified Data.Foldable.Compat as Foldable
+#endif
+
 #if !(MIN_VERSION_base(4,15,0))
 -- | Construct a 'NonEmpty' list from a single element.
 --
@@ -238,3 +244,35 @@ sortOn f = lift (List.sortOn f)
 lift :: Foldable.Foldable f => ([a] -> [b]) -> f a -> NonEmpty b
 lift f = fromList . f . Foldable.toList
 #endif
+
+#if !(MIN_VERSION_base(4,21,0))
+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative
+-- to 'compare' ('length' @xs@) @n@. Similarly, it's better
+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10@.
+--
+-- While 'length' would force and traverse
+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),
+-- 'compareLength' traverses at most @n@ elements to determine its result.
+--
+-- >>> compareLength ('a' :| []) 1
+-- EQ
+-- >>> compareLength ('a' :| ['b']) 3
+-- LT
+-- >>> compareLength (0 :| [1..]) 100
+-- GT
+-- >>> compareLength undefined 0
+-- GT
+-- >>> compareLength ('a' :| 'b' : undefined) 1
+-- GT
+--
+-- @since 4.21.0.0
+--
+compareLength :: NonEmpty a -> Int -> Ordering
+compareLength xs n
+  | n < 1 = GT
+  | otherwise = Foldable.foldr
+    (\_ f m -> if m > 0 then f (m - 1) else GT)
+    (\m -> if m > 0 then LT else EQ)
+    xs
+    n
+#endif