{-# LANGUAGE ScopedTypeVariables #-}

module HaskellWorks.Data.Streams.ByteString
  ( streamChunks
  , stream
  ) where

import Data.Word
import HaskellWorks.Data.Streams.Size
import HaskellWorks.Data.Streams.Stream (Step (..), Stream (..))
import Prelude                          hiding (foldl, map, sum, zipWith)

import qualified Data.ByteString as BS

streamChunks :: [BS.ByteString] -> Stream Word8
streamChunks :: [ByteString] -> Stream Word8
streamChunks [ByteString]
ass = (([ByteString], Int) -> Step ([ByteString], Int) Word8)
-> ([ByteString], Int) -> Size -> Stream Word8
forall s a. (s -> Step s a) -> s -> Size -> Stream a
Stream ([ByteString], Int) -> Step ([ByteString], Int) Word8
step ([ByteString]
ass, Int
0) Size
Unknown
  where step :: ([ByteString], Int) -> Step ([ByteString], Int) Word8
step ([ByteString]
bss, Int
i) = case [ByteString]
bss of
          ByteString
cs:[ByteString]
css -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
cs
            then Word8 -> ([ByteString], Int) -> Step ([ByteString], Int) Word8
forall s a. a -> s -> Step s a
Yield (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
cs Int
i) ([ByteString]
bss, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            else ([ByteString], Int) -> Step ([ByteString], Int) Word8
forall s a. s -> Step s a
Skip ([ByteString]
css, Int
0)
          [] -> Step ([ByteString], Int) Word8
forall s a. Step s a
Done
{-# INLINE [1] streamChunks #-}

stream :: BS.ByteString -> Stream Word8
stream :: ByteString -> Stream Word8
stream ByteString
bs = ((ByteString, Int) -> Step (ByteString, Int) Word8)
-> (ByteString, Int) -> Size -> Stream Word8
forall s a. (s -> Step s a) -> s -> Size -> Stream a
Stream (ByteString, Int) -> Step (ByteString, Int) Word8
step (ByteString
bs, Int
0) Size
Unknown
  where step :: (ByteString, Int) -> Step (ByteString, Int) Word8
step (ByteString
cs, Int
i) = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
cs
          then Word8 -> (ByteString, Int) -> Step (ByteString, Int) Word8
forall s a. a -> s -> Step s a
Yield (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
cs Int
i) (ByteString
cs, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else Step (ByteString, Int) Word8
forall s a. Step s a
Done
{-# INLINE [1] stream #-}