Straighten scans.

Data/ByteString/Lazy.hs

@@ -107,9 +107,9 @@ module Data.ByteString.Lazy (
         -- * Building ByteStrings
         -- ** Scans
         scanl,
---        scanl1,
---        scanr,
---        scanr1,
+        scanl1,
+        scanr,
+        scanr1,
 
         -- ** Accumulating maps
         mapAccumL,
@@ -623,11 +623,47 @@ scanl
     -- ^ input of length n
     -> ByteString
     -- ^ output of length n+1
-scanl f z = snd . foldl k (z,singleton z)
- where
-    k (c,acc) a = let n = f c a in (n, acc `snoc` n)
+scanl f = flip (foldr go singleton)
+  where
+    go value continuation accumulator =
+      let next = f accumulator value
+      in accumulator `cons` continuation next
 {-# INLINE scanl #-}
 
+-- | 'scanl1' is a variant of 'scanl' that has no starting value argument.
+-- This function will fuse.
+--
+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
+scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
+scanl1 _ Empty = Empty
+scanl1 f (Chunk c cs) = scanl f (S.unsafeHead c) (chunk (S.unsafeTail c) cs)
+
+-- | 'scanr' is similar to 'foldr', but returns a list of successive
+-- reduced values from the right.
+--
+-- > scanr f z [..., x{n-1}, xn] == [..., x{n-1} `f` (xn `f` z), xn `f` z, z]
+--
+-- Note that
+--
+-- > head (scanr f z xs) == foldr f z xs
+-- > last (scanr f z xs) == z
+--
+scanr
+    :: (Word8 -> Word8 -> Word8)
+    -- ^ element -> accumulator -> new accumulator
+    -> Word8
+    -- ^ starting value of accumulator
+    -> ByteString
+    -- ^ input of length n
+    -> ByteString
+    -- ^ output of length n+1
+scanr f z = pack . fmap (foldr f z) . tails
+
+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
+scanr1 _ Empty = Empty
+scanr1 f lazyByteString = scanr f (last lazyByteString) (init lazyByteString)
+
 -- ---------------------------------------------------------------------
 -- Unfolds and replicates
 

Data/ByteString/Lazy/Char8.hs

@@ -86,9 +86,9 @@ module Data.ByteString.Lazy.Char8 (
         -- * Building ByteStrings
         -- ** Scans
         scanl,
---      scanl1,
---      scanr,
---      scanr1,
+        scanl1,
+        scanr,
+        scanr1,
 
         -- ** Accumulating maps
         mapAccumL,
@@ -235,7 +235,7 @@ import Foreign.Storable (peek)
 import Prelude hiding
         (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines
         ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter
-        ,unwords,words,maximum,minimum,all,concatMap,scanl,scanl1,foldl1,foldr1
+        ,unwords,words,maximum,minimum,all,concatMap,scanl,scanl1,scanr,scanr1,foldl1,foldr1
         ,readFile,writeFile,appendFile,replicate,getContents,getLine,putStr,putStrLn
         ,zip,zipWith,unzip,notElem,repeat,iterate,interact,cycle)
 
@@ -409,6 +409,41 @@ minimum = w2c . L.minimum
 scanl :: (Char -> Char -> Char) -> Char -> ByteString -> ByteString
 scanl f z = L.scanl (\a b -> c2w (f (w2c a) (w2c b))) (c2w z)
 
+-- | 'scanl1' is a variant of 'scanl' that has no starting value argument.
+-- This function will fuse.
+--
+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
+scanl1 :: (Char -> Char -> Char) -> ByteString -> ByteString
+scanl1 f = L.scanl1 f'
+  where f' accumulator value = c2w (f (w2c accumulator) (w2c value))
+
+-- | 'scanr' is similar to 'foldr', but returns a list of successive
+-- reduced values from the right.
+--
+-- > scanr f z [..., x{n-1}, xn] == [..., x{n-1} `f` (xn `f` z), xn `f` z, z]
+--
+-- Note that
+--
+-- > head (scanr f z xs) == foldr f z xs
+-- > last (scanr f z xs) == z
+--
+scanr
+    :: (Char -> Char -> Char)
+    -- ^ element -> accumulator -> new accumulator
+    -> Char
+    -- ^ starting value of accumulator
+    -> ByteString
+    -- ^ input of length n
+    -> ByteString
+    -- ^ output of length n+1
+scanr f = L.scanr f' . c2w
+  where f' accumulator value = c2w (f (w2c accumulator) (w2c value))
+
+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+scanr1 :: (Char -> Char -> Char) -> ByteString -> ByteString
+scanr1 f = L.scanr1 f'
+  where f' accumulator value = c2w (f (w2c accumulator) (w2c value))
+
 -- | 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

tests/Properties.hs

@@ -470,9 +470,6 @@ short_tests =
 explosiveTail :: L.ByteString -> L.ByteString
 explosiveTail = (`L.append` error "Tail of this byte string is undefined!")
 
-explosiveTailD :: D.ByteString -> D.ByteString
-explosiveTailD = (`L.append` error "Tail of this byte string is undefined!")
-
 
 
 ------------------------------------------------------------------------
@@ -558,16 +555,24 @@ strictness_checks =
       L.foldr1 const (explosiveTail (xs `L.append` L.singleton 1)) == L.head xs
     , testProperty "foldr1' is strict" $ expectFailure $ \ xs ys -> L.length xs > 0 ==>
       L.foldr1' const (explosiveTail (xs `L.append` L.singleton 1 `L.append` ys)) == L.head xs
+    , testProperty "scanl is lazy" $ \ xs ->
+      L.take (L.length xs + 1) (L.scanl (+) 0 (explosiveTail (xs `L.append` L.singleton 1))) == (L.pack . fmap (L.foldr (+) 0) . L.inits) xs
+    , testProperty "scanl1 is lazy" $ \ xs -> L.length xs > 0 ==>
+      L.take (L.length xs) (L.scanl1 (+) (explosiveTail (xs `L.append` L.singleton 1))) == (L.pack . fmap (L.foldr1 (+)) . tail . L.inits) xs
     ]
   , testGroup "Lazy Char"
     [ testProperty "foldr is lazy" $ \ xs ->
-        genericTake (D.length xs) (D.foldr (:) [ ] (explosiveTailD xs)) == D.unpack xs
+        genericTake (D.length xs) (D.foldr (:) [ ] (explosiveTail xs)) == D.unpack xs
     , testProperty "foldr' is strict" $ expectFailure $ \ xs ys ->
-        genericTake (D.length xs) (D.foldr' (:) [ ] (explosiveTailD (xs `D.append` ys))) == D.unpack xs
+        genericTake (D.length xs) (D.foldr' (:) [ ] (explosiveTail (xs `D.append` ys))) == D.unpack xs
     , testProperty "foldr1 is lazy" $ \ xs -> D.length xs > 0 ==>
-        D.foldr1 const (explosiveTailD (xs `D.append` D.singleton 'x')) == D.head xs
+        D.foldr1 const (explosiveTail (xs `D.append` D.singleton 'x')) == D.head xs
     , testProperty "foldr1' is strict" $ expectFailure $ \ xs ys -> D.length xs > 0 ==>
-        D.foldr1' const (explosiveTailD (xs `D.append` D.singleton 'x' `D.append` ys)) == D.head xs
+        D.foldr1' const (explosiveTail (xs `D.append` D.singleton 'x' `D.append` ys)) == D.head xs
+    , testProperty "scanl is lazy" $ \ xs -> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in
+      D.take (D.length xs + 1) (D.scanl (+.) '\NUL' (explosiveTail (xs `D.append` D.singleton '\SOH'))) == (D.pack . fmap (D.foldr (+.) '\NUL') . D.inits) xs
+    , testProperty "scanl1 is lazy" $ \ xs -> D.length xs > 0 ==> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in
+      D.take (D.length xs) (D.scanl1 (+.) (explosiveTail (xs `D.append` D.singleton '\SOH'))) == (D.pack . fmap (D.foldr1 (+.)) . tail . D.inits) xs
     ]
   ]
 

tests/Properties/ByteString.hs

@@ -429,7 +429,6 @@ tests =
   , testProperty "scanl foldl" $
     \f (toElem -> c) x -> not (B.null x) ==> B.last (B.scanl ((toElem .) . f) c x) === B.foldl ((toElem .) . f) c x
 
-#ifndef BYTESTRING_LAZY
   , testProperty "scanr" $
     \f (toElem -> c) x -> B.unpack (B.scanr ((toElem .) . f) c x) === scanr ((toElem .) . f) c (B.unpack x)
   , testProperty "scanl1" $
@@ -440,6 +439,8 @@ tests =
     \f x -> B.unpack (B.scanr1 ((toElem .) . f) x) === scanr1 ((toElem .) . f) (B.unpack x)
   , testProperty "scanr1 empty" $
     \f -> B.scanr1 f B.empty === B.empty
+
+#ifndef BYTESTRING_LAZY
   , testProperty "sort" $
     \x -> B.unpack (B.sort x) === sort (B.unpack x)
 #endif