Implement Data.ByteString.Lazy.compareLength

Data/ByteString/Lazy.hs

@@ -102,6 +102,7 @@ module Data.ByteString.Lazy (
         all,                    -- :: (Word8 -> Bool) -> ByteString -> Bool
         maximum,                -- :: ByteString -> Word8
         minimum,                -- :: ByteString -> Word8
+        compareLength,          -- :: ByteString -> Int64 -> Ordering
 
         -- * Building ByteStrings
         -- ** Scans
@@ -300,7 +301,7 @@ null _     = False
 -- | /O(c)/ 'length' returns the length of a ByteString as an 'Int64'
 length :: ByteString -> Int64
 length cs = foldlChunks (\n c -> n + fromIntegral (S.length c)) 0 cs
-{-# INLINE length #-}
+{-# INLINE [1] length #-}
 
 infixr 5 `cons`, `cons'` --same as list (:)
 infixl 5 `snoc`
@@ -525,6 +526,85 @@ minimum (Chunk c cs) = foldlChunks (\n c' -> n `min` S.minimum c')
                                      (S.minimum c) cs
 {-# INLINE minimum #-}
 
+-- | /O(c)/ 'compareLength' compares the length of a 'ByteString' 
+-- to an 'Int64'   
+compareLength :: ByteString -> Int64 -> Ordering
+compareLength _ toCmp | toCmp < 0 = GT
+compareLength Empty toCmp         = compare 0 toCmp
+compareLength (Chunk c cs) toCmp  = compareLength cs (toCmp - fromIntegral (S.length c))
+{-# INLINE compareLength #-}
+
+{-# RULES 
+"ByteString.Lazy length/compareN -> compareLength" [~1] forall t n.
+  compare (length t) n = compareLength t n
+  #-}
+
+{-# RULES 
+"ByteString.Lazy compareN/length -> compareLength" [~1] forall t n.
+  compare n (length t) = negateOrdering $ compareLength t n
+  #-}
+
+{-# RULES 
+"ByteString.Lazy length/==N -> compareLength/==EQ" [~1] forall t n.
+   length t == n = compareLength t n == EQ
+  #-}
+
+{-# RULES 
+"ByteString.Lazy N==/length -> compareLength/==EQ" [~1] forall t n.
+   n == length t = compareLength t n == EQ
+  #-}
+
+{-# RULES 
+"ByteString.Lazy length//=N -> compareLength//=EQ" [~1] forall t n.
+   length t /= n = compareLength t n /= EQ
+  #-}
+
+{-# RULES 
+"ByteString.Lazy N/=/length -> compareLength//=EQ" [~1] forall t n.
+   n /= length t = compareLength t n /= EQ
+  #-}
+
+{-# RULES 
+"ByteString.Lazy length/<N -> compareLength/==LT" [~1] forall t n.
+   length t < n = compareLength t n == LT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy >N/length -> compareLength/==LT" [~1] forall t n.
+   n > length t = compareLength t n == LT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy length/<=N -> compareLength//=GT" [~1] forall t n.
+   length t <= n = compareLength t n /= GT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy <=N/length -> compareLength//=GT" [~1] forall t n.
+   n >= length t = compareLength t n /= GT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy length/>N -> compareLength/==GT" [~1] forall t n.
+   length t > n = compareLength t n == GT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy <N/length -> compareLength/==GT" [~1] forall t n.
+   n < length t = compareLength t n == GT
+  #-}
+
+
+{-# RULES 
+"ByteString.Lazy length/>=N -> compareLength//=LT" [~1] forall t n.
+   length t >= n = compareLength t n /= LT
+  #-}
+
+{-# RULES 
+"ByteString.Lazy >=N/length -> compareLength//=LT" [~1] forall t n.
+   n <= length t = compareLength t n /= LT
+  #-}
+
 -- | The 'mapAccumL' function behaves like a combination of 'map' and
 -- 'foldl'; it applies a function to each element of a ByteString,
 -- passing an accumulating parameter from left to right, and returning a
@@ -1344,6 +1424,12 @@ interact transformer = putStr . transformer =<< getContents
 -- ---------------------------------------------------------------------
 -- Internal utilities
 
+-- Required for rewrite rules for 'compareLength'
+negateOrdering :: Ordering -> Ordering
+negateOrdering LT = GT
+negateOrdering EQ = EQ
+negateOrdering GT = LT
+
 -- Common up near identical calls to `error' to reduce the number
 -- constant strings created when compiled:
 errorEmptyList :: String -> a

Data/ByteString/Lazy/Char8.hs

@@ -81,6 +81,7 @@ module Data.ByteString.Lazy.Char8 (
         all,                    -- :: (Char -> Bool) -> ByteString -> Bool
         maximum,                -- :: ByteString -> Char
         minimum,                -- :: ByteString -> Char
+        compareLength,          -- :: ByteString -> Int -> Ordering
 
         -- * Building ByteStrings
         -- ** Scans
@@ -207,7 +208,7 @@ import Data.ByteString.Lazy
         ,hGetContents, hGet, hPut, getContents
         ,hGetNonBlocking, hPutNonBlocking
         ,putStr, hPutStr, interact
-        ,readFile,writeFile,appendFile)
+        ,readFile,writeFile,appendFile,compareLength)
 
 -- Functions we need to wrap.
 import qualified Data.ByteString.Lazy as L

tests/Properties.hs

@@ -710,6 +710,13 @@ prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs))
 prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs ))
 prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs ))
 
+prop_compareLength1 xs  =  (L.pack xs         `L.compareLength` fromIntegral (length xs)) == EQ
+prop_compareLength2 xs c = (L.pack (xs ++ [c]) `L.compareLength` fromIntegral (length xs)) == GT
+prop_compareLength3 xs c = (L.pack xs `L.compareLength` fromIntegral (length (xs ++ [c]))) == LT
+prop_compareLength4 xs c = ((L.pack xs `L.append` L.pack [c] `L.append` L.pack [undefined]) 
+                            `L.compareLength` fromIntegral (length xs)) == GT
+prop_compareLength5 xs l = L.compareLength xs l == compare (L.length xs) l
+
 prop_replicate1 c =
     forAll arbitrary $ \(Positive n) ->
     unpack (L.replicate (fromIntegral n) c) == replicate n c
@@ -2407,6 +2414,11 @@ ll_tests =
     , testProperty "all"                prop_all
     , testProperty "maximum"            prop_maximum
     , testProperty "minimum"            prop_minimum
+    , testProperty "compareLength 1"    prop_compareLength1
+    , testProperty "compareLength 2"    prop_compareLength2
+    , testProperty "compareLength 3"    prop_compareLength3
+    , testProperty "compareLength 4"    prop_compareLength4
+    , testProperty "compareLength 5"    prop_compareLength5
     , testProperty "replicate 1"        prop_replicate1
     , testProperty "replicate 2"        prop_replicate2
     , testProperty "take"               prop_take1