{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}

-- |
-- Module      : Streaming.ByteString.Char8
-- Copyright   : (c) Don Stewart 2006
--               (c) Duncan Coutts 2006-2011
--               (c) Michael Thompson 2015
-- License     : BSD-style
--
-- This library emulates "Data.ByteString.Lazy.Char8" but includes a monadic
-- element and thus at certain points uses a `Stream`/@FreeT@ type in place of
-- lists. See the documentation for "Streaming.ByteString" and the examples
-- of of use to implement simple shell operations
-- <https://gist.github.com/michaelt/6c6843e6dd8030e95d58 here>. Examples of use
-- with @http-client@, @attoparsec@, @aeson@, @zlib@ etc. can be found in the
-- 'streaming-utils' library.

module Streaming.ByteString.Char8
  ( -- * The @ByteStream@ type
    ByteStream
  , ByteString

    -- * Introducing and eliminating 'ByteStream's
  , empty
  , pack
  , unpack
  , string
  , unlines
  , unwords
  , singleton
  , fromChunks
  , fromLazy
  , fromStrict
  , toChunks
  , toLazy
  , toLazy_
  , toStrict
  , toStrict_
  , effects
  , copy
  , drained
  , mwrap

    -- * Transforming ByteStreams
  , map
  , intercalate
  , intersperse

    -- * Basic interface
  , cons
  , cons'
  , snoc
  , append
  , filter
  , head
  , head_
  , last
  , last_
  , null
  , null_
  , nulls
  , testNull
  , uncons
  , nextChar
  , skipSomeWS

    -- * Substrings
    -- ** Breaking strings
  , break
  , drop
  , dropWhile
  , group
  , groupBy
  , span
  , splitAt
  , splitWith
  , take
  , takeWhile

    -- ** Breaking into many substrings
  , split
  , lines
  , lineSplit
  , words

    -- ** Special folds
  , concat
  , denull

    -- * Builders
  , toStreamingByteString

  , toStreamingByteStringWith

  , toBuilder
  , concatBuilders

    -- * Building ByteStreams
    -- ** Infinite ByteStreams
  , repeat
  , iterate
  , cycle

    -- ** Unfolding ByteStreams
  , unfoldr
  , unfoldM
  , reread

    -- *  Folds, including support for `Control.Foldl`
    -- , foldr
  , fold
  , fold_
  , length
  , length_
  , count
  , count_
  , readInt

    -- * I\/O with 'ByteStream's
    -- ** Standard input and output
  , getContents
  , stdin
  , stdout
  , interact
  , putStr
  , putStrLn

    -- ** Files
  , readFile
  , writeFile
  , appendFile

    -- ** I\/O with Handles
  , fromHandle
  , toHandle
  , hGet
  , hGetContents
  , hGetContentsN
  , hGetN
  , hGetNonBlocking
  , hGetNonBlockingN
  , hPut
    -- , hPutNonBlocking

    -- * Simple chunkwise operations
  , unconsChunk
  , nextChunk
  , chunk
  , foldrChunks
  , foldlChunks
  , chunkFold
  , chunkFoldM
  , chunkMap
  , chunkMapM
  , chunkMapM_

    -- * Etc.
  , dematerialize
  , materialize
  , distribute
  , zipWithStream
  ) where

import           Prelude hiding
    (all, any, appendFile, break, concat, concatMap, cycle, drop, dropWhile,
    elem, filter, foldl, foldl1, foldr, foldr1, getContents, getLine, head,
    init, interact, iterate, last, length, lines, map, maximum, minimum,
    notElem, null, putStr, putStrLn, readFile, repeat, replicate, reverse,
    scanl, scanl1, scanr, scanr1, span, splitAt, tail, take, takeWhile,
    unlines, unwords, unzip, words, writeFile, zip, zipWith)
import qualified Prelude

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import           Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B

import           Streaming hiding (concats, distribute, unfold)
import           Streaming.Internal (Stream(..))
import qualified Streaming.Prelude as SP

import qualified Streaming.ByteString as Q
import           Streaming.ByteString.Internal

import           Streaming.ByteString
    (append, appendFile, concat, concatBuilders, cycle, denull, distribute,
    drained, drop, effects, empty, fromChunks, fromHandle, fromLazy,
    fromStrict, getContents, group, hGet, hGetContents, hGetContentsN, hGetN,
    hGetNonBlocking, hGetNonBlockingN, hPut, interact, intercalate, length,
    length_, nextChunk, null, null_, nulls, readFile, splitAt, stdin, stdout,
    take, testNull, toBuilder, toChunks, toHandle, toLazy, toLazy_,
    toStreamingByteString, toStreamingByteStringWith, toStrict, toStrict_,
    unconsChunk, writeFile, zipWithStream)

import           Data.Bits ((.&.))
import           Data.Word (Word8)
import           Foreign.Ptr
import           Foreign.Storable
import qualified System.IO as IO

-- | Given a stream of bytes, produce a vanilla `Stream` of characters.
unpack :: Monad m => ByteStream m r -> Stream (Of Char) m r
unpack :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (Of Char) m r
unpack ByteStream m r
bs = case ByteStream m r
bs of
    Empty r
r    -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Go m (ByteStream m r)
m       -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (Of Char) m r
unpack m (ByteStream m r)
m)
    Chunk ByteString
c ByteStream m r
cs -> forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsLazy ByteString
c (forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (Of Char) m r
unpack ByteStream m r
cs)
  where
  unpackAppendCharsLazy :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
  unpackAppendCharsLazy :: forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsLazy (B.PS ForeignPtr Word8
fp Int
off Int
len) Stream (Of Char) m r
xs
   | Int
len forall a. Ord a => a -> a -> Bool
<= Int
100 = forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fp Int
off Int
len) Stream (Of Char) m r
xs
   | Bool
otherwise  = forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsStrict (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fp Int
off Int
100) Stream (Of Char) m r
remainder
   where
     remainder :: Stream (Of Char) m r
remainder  = forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsLazy (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
fp (Int
offforall a. Num a => a -> a -> a
+Int
100) (Int
lenforall a. Num a => a -> a -> a
-Int
100)) Stream (Of Char) m r
xs

  unpackAppendCharsStrict :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
  unpackAppendCharsStrict :: forall (m :: * -> *) r.
ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r
unpackAppendCharsStrict (B.PS ForeignPtr Word8
fp Int
off Int
len) Stream (Of Char) m r
xs =
    forall a. IO a -> a
B.accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base -> do
         forall {m :: * -> *} {r}.
Ptr Word8
-> Ptr Word8 -> Stream (Of Char) m r -> IO (Stream (Of Char) m r)
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offforall a. Num a => a -> a -> a
-Int
1)) (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
len)) Stream (Of Char) m r
xs
     where
       loop :: Ptr Word8
-> Ptr Word8 -> Stream (Of Char) m r -> IO (Stream (Of Char) m r)
loop !Ptr Word8
sentinal !Ptr Word8
p Stream (Of Char) m r
acc
         | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== Ptr Word8
sentinal = forall (m :: * -> *) a. Monad m => a -> m a
return Stream (Of Char) m r
acc
         | Bool
otherwise     = do Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
                              Ptr Word8
-> Ptr Word8 -> Stream (Of Char) m r -> IO (Stream (Of Char) m r)
loop Ptr Word8
sentinal (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) (forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Word8 -> Char
B.w2c Word8
x forall a b. a -> b -> Of a b
:> Stream (Of Char) m r
acc))
{-# INLINABLE unpack #-}

-- | /O(n)/ Convert a stream of separate characters into a packed byte stream.
pack :: Monad m => Stream (Of Char) m r -> ByteStream m r
pack :: forall (m :: * -> *) r.
Monad m =>
Stream (Of Char) m r -> ByteStream m r
pack  = forall (m :: * -> *) r.
Monad m =>
Stream (Of ByteString) m r -> ByteStream m r
fromChunks
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> m (g x)) -> Stream f m r -> Stream g m r
mapped (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
str :> x
r) -> String -> ByteString
Char8.pack String
str forall a b. a -> b -> Of a b
:> x
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a r.
Monad m =>
Stream (Of a) m r -> m (Of [a] r)
SP.toList)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
Int -> Stream f m r -> Stream (Stream f m) m r
chunksOf Int
32
{-# INLINABLE pack #-}

-- | /O(1)/ Cons a 'Char' onto a byte stream.
cons :: Monad m => Char -> ByteStream m r -> ByteStream m r
cons :: forall (m :: * -> *) r.
Monad m =>
Char -> ByteStream m r -> ByteStream m r
cons Char
c = forall (m :: * -> *) r.
Monad m =>
Word8 -> ByteStream m r -> ByteStream m r
Q.cons (Char -> Word8
c2w Char
c)
{-# INLINE cons #-}

-- | /O(1)/ Yield a 'Char' as a minimal 'ByteStream'
singleton :: Monad m => Char -> ByteStream m ()
singleton :: forall (m :: * -> *). Monad m => Char -> ByteStream m ()
singleton = forall (m :: * -> *). Monad m => Word8 -> ByteStream m ()
Q.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE singleton #-}

-- | /O(1)/ Unlike 'cons', 'cons\'' is
-- strict in the ByteString that we are consing onto. More precisely, it forces
-- the head and the first chunk. It does this because, for space efficiency, it
-- may coalesce the new byte onto the first \'chunk\' rather than starting a
-- new \'chunk\'.
--
-- So that means you can't use a lazy recursive contruction like this:
--
-- > let xs = cons\' c xs in xs
--
-- You can however use 'cons', as well as 'repeat' and 'cycle', to build
-- infinite lazy ByteStreams.
--
cons' :: Char -> ByteStream m r -> ByteStream m r
cons' :: forall (m :: * -> *) r. Char -> ByteStream m r -> ByteStream m r
cons' Char
c (Chunk ByteString
bs ByteStream m r
bss) | ByteString -> Int
B.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
16 = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Word8 -> ByteString -> ByteString
B.cons (Char -> Word8
c2w Char
c) ByteString
bs) ByteStream m r
bss
cons' Char
c ByteStream m r
cs             = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
c)) ByteStream m r
cs
{-# INLINE cons' #-}
--
-- | /O(n\/c)/ Append a byte to the end of a 'ByteStream'
snoc :: Monad m => ByteStream m r -> Char -> ByteStream m r
snoc :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Char -> ByteStream m r
snoc ByteStream m r
cs = forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Word8 -> ByteStream m r
Q.snoc ByteStream m r
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE snoc #-}

-- | /O(1)/ Extract the first element of a ByteStream, which must be non-empty.
head_ :: Monad m => ByteStream m r -> m Char
head_ :: forall (m :: * -> *) r. Monad m => ByteStream m r -> m Char
head_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ByteStream m r -> m Word8
Q.head_
{-# INLINE head_ #-}

-- | /O(1)/ Extract the first element of a ByteStream, if possible. Suitable for
-- use with `SP.mapped`:
--
-- @
-- S.mapped Q.head :: Stream (Q.ByteStream m) m r -> Stream (Of (Maybe Char)) m r
-- @
head :: Monad m => ByteStream m r -> m (Of (Maybe Char) r)
head :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Of (Maybe Char) r)
head = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Word8
m:>r
r) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c Maybe Word8
m forall a b. a -> b -> Of a b
:> r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Of (Maybe Word8) r)
Q.head
{-# INLINE head #-}

-- | /O(n\/c)/ Extract the last element of a ByteStream, which must be finite
-- and non-empty.
last_ :: Monad m => ByteStream m r -> m Char
last_ :: forall (m :: * -> *) r. Monad m => ByteStream m r -> m Char
last_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ByteStream m r -> m Word8
Q.last_
{-# INLINE last_ #-}

-- | Extract the last element of a `ByteStream`, if possible. Suitable for use
-- with `SP.mapped`:
--
-- @
-- S.mapped Q.last :: Streaming (ByteStream m) m r -> Stream (Of (Maybe Char)) m r
-- @
last :: Monad m => ByteStream m r -> m (Of (Maybe Char) r)
last :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Of (Maybe Char) r)
last = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Word8
m:>r
r) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c Maybe Word8
m forall a b. a -> b -> Of a b
:> r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Of (Maybe Word8) r)
Q.last
{-# INLINE last #-}

-- | The 'groupBy' function is a generalized version of 'group'.
groupBy :: Monad m => (Char -> Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r
groupBy :: forall (m :: * -> *) r.
Monad m =>
(Char -> Char -> Bool)
-> ByteStream m r -> Stream (ByteStream m) m r
groupBy Char -> Char -> Bool
rel = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Word8 -> Bool)
-> ByteStream m r -> Stream (ByteStream m) m r
Q.groupBy (\Word8
w Word8
w' -> Char -> Char -> Bool
rel (Word8 -> Char
w2c Word8
w) (Word8 -> Char
w2c Word8
w'))
{-# INLINE groupBy #-}

-- | /O(1)/ Extract the head and tail of a 'ByteStream', or its return value if
-- it is empty. This is the \'natural\' uncons for an effectful byte stream.
uncons :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r))
uncons :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (Char, ByteStream m r))
uncons (Chunk c :: ByteString
c@(ByteString -> Int
B.length -> Int
len) ByteStream m r
cs)
    | Int
len forall a. Ord a => a -> a -> Bool
> Int
0    = let !h :: Char
h = Word8 -> Char
w2c forall a b. (a -> b) -> a -> b
$ ByteString -> Word8
B.unsafeHead ByteString
c
                       !t :: ByteStream m r
t = if Int
len forall a. Ord a => a -> a -> Bool
> Int
1 then forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (ByteString -> ByteString
B.unsafeTail ByteString
c) ByteStream m r
cs else ByteStream m r
cs
                    in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Char
h, ByteStream m r
t)
    | Bool
otherwise  = forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (Char, ByteStream m r))
uncons ByteStream m r
cs
uncons (Go m (ByteStream m r)
m)    = m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (Char, ByteStream m r))
uncons
uncons (Empty r
r) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left r
r)
{-# INLINABLE uncons #-}

-- | The same as `uncons`, will be removed in the next version.
nextChar :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r))
nextChar :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (Char, ByteStream m r))
nextChar = forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (Char, ByteStream m r))
uncons
{-# INLINABLE nextChar #-}
{-# DEPRECATED nextChar "Use uncons instead." #-}

-- ---------------------------------------------------------------------
-- Transformations

-- | /O(n)/ 'map' @f xs@ is the ByteStream obtained by applying @f@ to each
-- element of @xs@.
map :: Monad m => (Char -> Char) -> ByteStream m r -> ByteStream m r
map :: forall (m :: * -> *) r.
Monad m =>
(Char -> Char) -> ByteStream m r -> ByteStream m r
map Char -> Char
f = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Word8) -> ByteStream m r -> ByteStream m r
Q.map (Char -> Word8
c2w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE map #-}

-- | The 'intersperse' function takes a 'Char' and a 'ByteStream' and
-- \`intersperses\' that byte between the elements of the 'ByteStream'.
-- It is analogous to the intersperse function on Streams.
intersperse :: Monad m => Char -> ByteStream m r -> ByteStream m r
intersperse :: forall (m :: * -> *) r.
Monad m =>
Char -> ByteStream m r -> ByteStream m r
intersperse Char
c = forall (m :: * -> *) r.
Monad m =>
Word8 -> ByteStream m r -> ByteStream m r
Q.intersperse (Char -> Word8
c2w Char
c)
{-# INLINE intersperse #-}

-- -- ---------------------------------------------------------------------
-- -- Reducing 'ByteStream's

-- | 'fold_' keeps the return value of the left-folded bytestring. Useful for
-- simultaneous folds over a segmented bytestream.
fold_ :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m () -> m b
fold_ :: forall (m :: * -> *) x b.
Monad m =>
(x -> Char -> x) -> x -> (x -> b) -> ByteStream m () -> m b
fold_ x -> Char -> x
step x
begin x -> b
done ByteStream m ()
p0 = forall {m :: * -> *} {r}. Monad m => ByteStream m r -> x -> m b
loop ByteStream m ()
p0 x
begin
  where
    loop :: ByteStream m r -> x -> m b
loop ByteStream m r
p !x
x = case ByteStream m r
p of
        Chunk ByteString
bs ByteStream m r
bss -> ByteStream m r -> x -> m b
loop ByteStream m r
bss forall a b. (a -> b) -> a -> b
$! forall a. (a -> Char -> a) -> a -> ByteString -> a
Char8.foldl' x -> Char -> x
step x
x ByteString
bs
        Go    m (ByteStream m r)
m      -> m (ByteStream m r)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteStream m r
p' -> ByteStream m r -> x -> m b
loop ByteStream m r
p' x
x
        Empty r
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
{-# INLINABLE fold_ #-}

-- | Like `fold_`, but suitable for use with `S.mapped`.
fold :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m r -> m (Of b r)
fold :: forall (m :: * -> *) x b r.
Monad m =>
(x -> Char -> x) -> x -> (x -> b) -> ByteStream m r -> m (Of b r)
fold x -> Char -> x
step x
begin x -> b
done ByteStream m r
p0 = forall {m :: * -> *} {b}.
Monad m =>
ByteStream m b -> x -> m (Of b b)
loop ByteStream m r
p0 x
begin
  where
    loop :: ByteStream m b -> x -> m (Of b b)
loop ByteStream m b
p !x
x = case ByteStream m b
p of
        Chunk ByteString
bs ByteStream m b
bss -> ByteStream m b -> x -> m (Of b b)
loop ByteStream m b
bss forall a b. (a -> b) -> a -> b
$! forall a. (a -> Char -> a) -> a -> ByteString -> a
Char8.foldl' x -> Char -> x
step x
x ByteString
bs
        Go    m (ByteStream m b)
m      -> m (ByteStream m b)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteStream m b
p' -> ByteStream m b -> x -> m (Of b b)
loop ByteStream m b
p' x
x
        Empty b
r      -> forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x forall a b. a -> b -> Of a b
:> b
r)
{-# INLINABLE fold #-}

-- ---------------------------------------------------------------------
-- Unfolds and replicates

-- | @'iterate' f x@ returns an infinite ByteStream of repeated applications
-- of @f@ to @x@:
--
-- > iterate f x == [x, f x, f (f x), ...]
iterate :: (Char -> Char) -> Char -> ByteStream m r
iterate :: forall (m :: * -> *) r. (Char -> Char) -> Char -> ByteStream m r
iterate Char -> Char
f Char
c = forall (m :: * -> *) r. (Word8 -> Word8) -> Word8 -> ByteStream m r
Q.iterate (Char -> Word8
c2w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c) (Char -> Word8
c2w Char
c)
{-# INLINE iterate #-}

-- | @'repeat' x@ is an infinite ByteStream, with @x@ the value of every
-- element.
repeat :: Char -> ByteStream m r
repeat :: forall (m :: * -> *) r. Char -> ByteStream m r
repeat = forall (m :: * -> *) r. Word8 -> ByteStream m r
Q.repeat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
{-# INLINE repeat #-}

-- | 'cycle' ties a finite ByteStream into a circular one, or equivalently,
-- the infinite repetition of the original ByteStream.
--
-- | /O(n)/ The 'unfoldM' function is analogous to the Stream \'unfoldr\'.
-- 'unfoldM' builds a ByteStream from a seed value. The function takes the
-- element and returns 'Nothing' if it is done producing the ByteStream or
-- returns 'Just' @(a,b)@, in which case, @a@ is a prepending to the ByteStream
-- and @b@ is used as the next element in a recursive call.
unfoldM :: Monad m => (a -> Maybe (Char, a)) -> a -> ByteStream m ()
unfoldM :: forall (m :: * -> *) a.
Monad m =>
(a -> Maybe (Char, a)) -> a -> ByteStream m ()
unfoldM a -> Maybe (Char, a)
f = forall (m :: * -> *) a.
Monad m =>
(a -> Maybe (Word8, a)) -> a -> ByteStream m ()
Q.unfoldM a -> Maybe (Word8, a)
go where
  go :: a -> Maybe (Word8, a)
go a
a = case a -> Maybe (Char, a)
f a
a of
    Maybe (Char, a)
Nothing     -> forall a. Maybe a
Nothing
    Just (Char
c,a
a') -> forall a. a -> Maybe a
Just (Char -> Word8
c2w Char
c, a
a')
{-# INLINE unfoldM #-}

-- | Given some pure process that produces characters, generate a stream of
-- bytes. The @r@ produced by the final `Left` will be the return value at the
-- end of the stream. Note also that the `Char` values will be truncated to
-- 8-bits.
unfoldr :: (a -> Either r (Char, a)) -> a -> ByteStream m r
unfoldr :: forall a r (m :: * -> *).
(a -> Either r (Char, a)) -> a -> ByteStream m r
unfoldr a -> Either r (Char, a)
step = forall a r (m :: * -> *).
(a -> Either r (Word8, a)) -> a -> ByteStream m r
Q.unfoldr (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (\(Char
c,a
a) -> forall a b. b -> Either a b
Right (Char -> Word8
c2w Char
c,a
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either r (Char, a)
step)
{-# INLINE unfoldr #-}

-- | 'takeWhile', applied to a predicate @p@ and a ByteStream @xs@,
-- returns the longest prefix (possibly empty) of @xs@ of elements that
-- satisfy @p@.
takeWhile :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m ()
takeWhile :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m ()
takeWhile Char -> Bool
f  = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> ByteStream m ()
Q.takeWhile (Char -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE takeWhile #-}

-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.
dropWhile :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m r
dropWhile :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m r
dropWhile Char -> Bool
f = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> ByteStream m r
Q.dropWhile (Char -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE dropWhile #-}

-- | 'break' @p@ is equivalent to @'span' ('not' . p)@.
break :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
break :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
break Char -> Bool
f = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
Q.break (Char -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE break #-}

-- | 'span' @p xs@ breaks the ByteStream into two segments. It is
-- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
span :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
span :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
span Char -> Bool
p = forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r)
break (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p)
{-# INLINE span #-}

-- | Like `split`, but you can supply your own splitting predicate.
splitWith :: Monad m => (Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r
splitWith :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r
splitWith Char -> Bool
f = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r
Q.splitWith (Char -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE splitWith #-}

{- | /O(n)/ Break a 'ByteStream' into pieces separated by the byte
     argument, consuming the delimiter. I.e.

> split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
> split 'a'  "aXaXaXa"    == ["","X","X","X",""]
> split 'x'  "x"          == ["",""]

     and

> intercalate [c] . split c == id
> split == splitWith . (==)

As for all splitting functions in this library, this function does not copy the
substrings, it just constructs new 'ByteStream's that are slices of the
original.

>>> Q.stdout $ Q.unlines $ Q.split 'n' "banana peel"
ba
a
a peel
-}
split :: Monad m => Char -> ByteStream m r -> Stream (ByteStream m) m r
split :: forall (m :: * -> *) r.
Monad m =>
Char -> ByteStream m r -> Stream (ByteStream m) m r
split Char
c = forall (m :: * -> *) r.
Monad m =>
Word8 -> ByteStream m r -> Stream (ByteStream m) m r
Q.split (Char -> Word8
c2w Char
c)
{-# INLINE split #-}

-- -- ---------------------------------------------------------------------
-- -- Searching ByteStreams

-- | /O(n)/ 'filter', applied to a predicate and a ByteStream,
-- returns a ByteStream containing those characters that satisfy the
-- predicate.
filter :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m r
filter :: forall (m :: * -> *) r.
Monad m =>
(Char -> Bool) -> ByteStream m r -> ByteStream m r
filter Char -> Bool
p = forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> ByteStream m r
Q.filter (Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c)
{-# INLINE filter #-}

-- | 'lines' turns a ByteStream into a connected stream of ByteStreams at divide
-- at newline characters. The resulting strings do not contain newlines. This is
-- the genuinely streaming 'lines' which only breaks chunks, and thus never
-- increases the use of memory.
--
-- Because 'ByteStream's are usually read in binary mode, with no line ending
-- conversion, this function recognizes both @\\n@ and @\\r\\n@ endings
-- (regardless of the current platform).
lines :: forall m r . Monad m => ByteStream m r -> Stream (ByteStream m) m r
lines :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (ByteStream m) m r
lines ByteStream m r
text0 = ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
text0
  where
    loop1 :: ByteStream m r -> Stream (ByteStream m) m r
    loop1 :: ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
text =
      case ByteStream m r
text of
        Empty r
r -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
        Go m (ByteStream m r)
m -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteStream m r -> Stream (ByteStream m) m r
loop1 m (ByteStream m r)
m
        Chunk ByteString
c ByteStream m r
cs
          | ByteString -> Bool
B.null ByteString
c -> ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
cs
          | Bool
otherwise -> forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
False ByteStream m r
text)
    loop2 :: Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
    loop2 :: Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
prevCr ByteStream m r
text =
      case ByteStream m r
text of
        Empty r
r -> if Bool
prevCr
          then forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Word8 -> ByteString
B.singleton Word8
13) (forall (m :: * -> *) r. r -> ByteStream m r
Empty (forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r))
          else forall (m :: * -> *) r. r -> ByteStream m r
Empty (forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
        Go m (ByteStream m r)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
prevCr) m (ByteStream m r)
m
        Chunk ByteString
c ByteStream m r
cs ->
          case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
10 ByteString
c of
            Maybe Int
Nothing -> if ByteString -> Bool
B.null ByteString
c
              then Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
prevCr ByteStream m r
cs
              else if ByteString -> Word8
unsafeLast ByteString
c forall a. Eq a => a -> a -> Bool
== Word8
13
                then forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (ByteString -> ByteString
unsafeInit ByteString
c) (Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
True ByteStream m r
cs)
                else forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
c (Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Bool
False ByteStream m r
cs)
            Just Int
i -> do
              let prefixLength :: Int
prefixLength =
                    if Int
i forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& ByteString -> Int -> Word8
B.unsafeIndex ByteString
c (Int
iforall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== Word8
13 -- \r\n (dos)
                      then Int
iforall a. Num a => a -> a -> a
-Int
1
                      else Int
i
                  rest :: ByteStream m r
rest =
                    if ByteString -> Int
B.length ByteString
c forall a. Ord a => a -> a -> Bool
> Int
iforall a. Num a => a -> a -> a
+Int
1
                      then forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Int -> ByteString -> ByteString
B.drop (Int
iforall a. Num a => a -> a -> a
+Int
1) ByteString
c) ByteStream m r
cs
                      else ByteStream m r
cs
                  result :: ByteStream m (Stream (ByteStream m) m r)
result = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Int -> ByteString -> ByteString
B.unsafeTake Int
prefixLength ByteString
c) (forall (m :: * -> *) r. r -> ByteStream m r
Empty (ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
rest))
              if Int
i forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool
prevCr
                then forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Word8 -> ByteString
B.singleton Word8
13) forall {m :: * -> *}. ByteStream m (Stream (ByteStream m) m r)
result
                else forall {m :: * -> *}. ByteStream m (Stream (ByteStream m) m r)
result
{-# INLINABLE lines #-}

-- | The 'unlines' function restores line breaks between layers.
--
-- Note that this is not a perfect inverse of 'lines':
--
--  * @'lines' . 'unlines'@ can produce more strings than there were if some of
--  the \"lines\" had embedded newlines.
--
--  * @'unlines' . 'lines'@ will replace @\\r\\n@ with @\\n@.
unlines :: Monad m => Stream (ByteStream m) m r -> ByteStream m r
unlines :: forall (m :: * -> *) r.
Monad m =>
Stream (ByteStream m) m r -> ByteStream m r
unlines = forall (m :: * -> *) r.
Monad m =>
Stream (ByteStream m) m r -> ByteStream m r
loop where
  loop :: Stream (ByteStream m) m r -> ByteStream m r
loop Stream (ByteStream m) m r
str =  case Stream (ByteStream m) m r
str of
    Return r
r -> forall (m :: * -> *) r. r -> ByteStream m r
Empty r
r
    Step ByteStream m (Stream (ByteStream m) m r)
bstr   -> do
      Stream (ByteStream m) m r
st <- ByteStream m (Stream (ByteStream m) m r)
bstr
      forall (m :: * -> *) r. Char -> ByteStream m r -> ByteStream m r
cons' Char
'\n' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
Monad m =>
Stream (ByteStream m) m r -> ByteStream m r
unlines Stream (ByteStream m) m r
st
    Effect m (Stream (ByteStream m) m r)
m  -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) r.
Monad m =>
Stream (ByteStream m) m r -> ByteStream m r
unlines m (Stream (ByteStream m) m r)
m)
{-# INLINABLE unlines #-}

-- | 'words' breaks a byte stream up into a succession of byte streams
-- corresponding to words, breaking on 'Char's representing white space. This is
-- the genuinely streaming 'words'. A function that returns individual strict
-- bytestrings would concatenate even infinitely long words like @cycle "y"@ in
-- memory. When the stream is known to not contain unreasonably long words, you
-- can write @mapped toStrict . words@ or the like, if strict bytestrings are
-- needed.
words :: Monad m => ByteStream m r -> Stream (ByteStream m) m r
words :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Stream (ByteStream m) m r
words = forall {m :: * -> *} {r}.
Monad m =>
Stream (ByteStream m) m r -> Stream (ByteStream m) m r
filtered forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
Monad m =>
(Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r
Q.splitWith Word8 -> Bool
w8IsSpace
 where
  filtered :: Stream (ByteStream m) m r -> Stream (ByteStream m) m r
filtered Stream (ByteStream m) m r
stream = case Stream (ByteStream m) m r
stream of
    Return r
r -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
    Effect m (Stream (ByteStream m) m r)
m -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (ByteStream m) m r -> Stream (ByteStream m) m r
filtered m (Stream (ByteStream m) m r)
m)
    Step ByteStream m (Stream (ByteStream m) m r)
bs  -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect forall a b. (a -> b) -> a -> b
$ ByteStream m (Stream (ByteStream m) m r)
-> m (Stream (ByteStream m) m r)
bs_loop ByteStream m (Stream (ByteStream m) m r)
bs
  bs_loop :: ByteStream m (Stream (ByteStream m) m r)
-> m (Stream (ByteStream m) m r)
bs_loop ByteStream m (Stream (ByteStream m) m r)
bs = case ByteStream m (Stream (ByteStream m) m r)
bs of
      Empty Stream (ByteStream m) m r
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Stream (ByteStream m) m r -> Stream (ByteStream m) m r
filtered Stream (ByteStream m) m r
r
      Go m (ByteStream m (Stream (ByteStream m) m r))
m ->  m (ByteStream m (Stream (ByteStream m) m r))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteStream m (Stream (ByteStream m) m r)
-> m (Stream (ByteStream m) m r)
bs_loop
      Chunk ByteString
b ByteStream m (Stream (ByteStream m) m r)
bs' -> if ByteString -> Bool
B.null ByteString
b
        then ByteStream m (Stream (ByteStream m) m r)
-> m (Stream (ByteStream m) m r)
bs_loop ByteStream m (Stream (ByteStream m) m r)
bs'
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
b (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream (ByteStream m) m r -> Stream (ByteStream m) m r
filtered ByteStream m (Stream (ByteStream m) m r)
bs')
{-# INLINABLE words #-}

-- | The 'unwords' function is analogous to the 'unlines' function, on words.
unwords :: Monad m => Stream (ByteStream m) m r -> ByteStream m r
unwords :: forall (m :: * -> *) r.
Monad m =>
Stream (ByteStream m) m r -> ByteStream m r
unwords = forall (m :: * -> *) r.
Monad m =>
ByteStream m () -> Stream (ByteStream m) m r -> ByteStream m r
intercalate (forall (m :: * -> *). Monad m => Char -> ByteStream m ()
singleton Char
' ')
{-# INLINE unwords #-}


{- | 'lineSplit' turns a ByteStream into a connected stream of ByteStreams at
     divide after a fixed number of newline characters.
     Unlike most of the string splitting functions in this library,
     this function preserves newlines characters.

     Like 'lines', this function properly handles both @\\n@ and @\\r\\n@
     endings regardless of the current platform. It does not support @\\r@ or
     @\\n\\r@ line endings.

     >>> let planets = ["Mercury","Venus","Earth","Mars","Saturn","Jupiter","Neptune","Uranus"]
     >>> S.mapsM_ (\x -> putStrLn "Chunk" >> Q.putStrLn x) $ Q.lineSplit 3 $ Q.string $ L.unlines planets
     Chunk
     Mercury
     Venus
     Earth

     Chunk
     Mars
     Saturn
     Jupiter

     Chunk
     Neptune
     Uranus

     Since all characters originally present in the stream are preserved,
     this function satisfies the following law:

     > Ɐ n bs. concat (lineSplit n bs) ≅ bs
-}
lineSplit :: forall m r. Monad m
  => Int -- ^ number of lines per group
  -> ByteStream m r -- ^ stream of bytes
  -> Stream (ByteStream m) m r
lineSplit :: forall (m :: * -> *) r.
Monad m =>
Int -> ByteStream m r -> Stream (ByteStream m) m r
lineSplit !Int
n0 ByteStream m r
text0 = ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
text0
  where
    n :: Int
    !n :: Int
n = forall a. Ord a => a -> a -> a
max Int
n0 Int
1
    loop1 :: ByteStream m r -> Stream (ByteStream m) m r
    loop1 :: ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
text =
      case ByteStream m r
text of
        Empty r
r -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r
        Go m (ByteStream m r)
m -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
Effect forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteStream m r -> Stream (ByteStream m) m r
loop1 m (ByteStream m r)
m
        Chunk ByteString
c ByteStream m r
cs
          | ByteString -> Bool
B.null ByteString
c -> ByteStream m r -> Stream (ByteStream m) m r
loop1 ByteStream m r
cs
          | Bool
otherwise -> forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
Step (Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Int
0 ByteStream m r
text)
    loop2 :: Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
    loop2 :: Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 !Int
counter ByteStream m r
text =
      case ByteStream m r
text of
        Empty r
r -> forall (m :: * -> *) r. r -> ByteStream m r
Empty (forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return r
r)
        Go m (ByteStream m r)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 Int
counter) m (ByteStream m r)
m
        Chunk ByteString
c ByteStream m r
cs ->
          case ByteString -> Int -> Either Int Int
nthNewLine ByteString
c (Int
n forall a. Num a => a -> a -> a
- Int
counter) of
            Left  !Int
i -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
c (Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r)
loop2 (Int
counter forall a. Num a => a -> a -> a
+ Int
i) ByteStream m r
cs)
            Right !Int
l -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Int -> ByteString -> ByteString
B.unsafeTake Int
l ByteString
c)
                        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. r -> ByteStream m r
Empty forall a b. (a -> b) -> a -> b
$ ByteStream m r -> Stream (ByteStream m) m r
loop1 forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Int -> ByteString -> ByteString
B.unsafeDrop Int
l ByteString
c) ByteStream m r
cs
{-# INLINABLE lineSplit #-}

-- | Return either how many newlines a strict bytestring chunk contains, if
-- fewer than the number requested, or, else the total length of the requested
-- number of lines within the bytestring (equivalently, i.e. the start index of
-- the first /unwanted line/).
nthNewLine :: B.ByteString   -- input chunk
           -> Int            -- remaining number of newlines wanted
           -> Either Int Int -- Left count, else Right length
nthNewLine :: ByteString -> Int -> Either Int Int
nthNewLine (B.PS ForeignPtr Word8
fp Int
off Int
len) Int
targetLines =
    forall a. IO a -> a
B.accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base ->
    Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int)
loop (Ptr Word8
base forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Int
targetLines Int
0 Int
len
  where
    loop :: Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int)
    loop :: Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int)
loop !Ptr Word8
_ Int
0 !Int
startIx !Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Int
startIx
    loop !Ptr Word8
p !Int
linesNeeded !Int
startIx !Int
bytesLeft = do
      Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memchr Ptr Word8
p Word8
newline forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytesLeft
      if Ptr Word8
q forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! Int
targetLines forall a. Num a => a -> a -> a
- Int
linesNeeded
      else let !pnext :: Ptr b
pnext = Ptr Word8
q forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
               !skip :: Int
skip  = forall a. Ptr a
pnext forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
               !snext :: Int
snext = Int
startIx forall a. Num a => a -> a -> a
+ Int
skip
               !bytes :: Int
bytes = Int
bytesLeft forall a. Num a => a -> a -> a
- Int
skip
            in Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int)
loop forall a. Ptr a
pnext (Int
linesNeeded forall a. Num a => a -> a -> a
- Int
1) Int
snext Int
bytes

newline :: Word8
newline :: Word8
newline = Word8
10
{-# INLINE newline #-}

-- | Promote a vanilla `String` into a stream.
--
-- /Note:/ Each `Char` is truncated to 8 bits.
string :: String -> ByteStream m ()
string :: forall (m :: * -> *). String -> ByteStream m ()
string = forall (m :: * -> *). ByteString -> ByteStream m ()
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
B.c2w
{-# INLINE string #-}

-- | Returns the number of times its argument appears in the `ByteStream`.
count_ :: Monad m => Char -> ByteStream m r -> m Int
count_ :: forall (m :: * -> *) r. Monad m => Char -> ByteStream m r -> m Int
count_ Char
c = forall (m :: * -> *) r. Monad m => Word8 -> ByteStream m r -> m Int
Q.count_ (Char -> Word8
c2w Char
c)
{-# INLINE count_ #-}

-- | Returns the number of times its argument appears in the `ByteStream`.
-- Suitable for use with `SP.mapped`:
--
-- @
-- S.mapped (Q.count \'a\') :: Stream (Q.ByteStream m) m r -> Stream (Of Int) m r
-- @
count :: Monad m => Char -> ByteStream m r -> m (Of Int r)
count :: forall (m :: * -> *) r.
Monad m =>
Char -> ByteStream m r -> m (Of Int r)
count Char
c = forall (m :: * -> *) r.
Monad m =>
Word8 -> ByteStream m r -> m (Of Int r)
Q.count (Char -> Word8
c2w Char
c)
{-# INLINE count #-}

-- | Print a stream of bytes to STDOUT.
putStr :: MonadIO m => ByteStream m r -> m r
putStr :: forall (m :: * -> *) r. MonadIO m => ByteStream m r -> m r
putStr = forall (m :: * -> *) r.
MonadIO m =>
Handle -> ByteStream m r -> m r
hPut Handle
IO.stdout
{-# INLINE putStr #-}

-- | Print a stream of bytes to STDOUT, ending with a final @\n@.
--
-- /Note:/ The final @\n@ is not added atomically, and in certain multi-threaded
-- scenarios might not appear where expected.
putStrLn :: MonadIO m => ByteStream m r -> m r
putStrLn :: forall (m :: * -> *) r. MonadIO m => ByteStream m r -> m r
putStrLn ByteStream m r
bs = forall (m :: * -> *) r.
MonadIO m =>
Handle -> ByteStream m r -> m r
hPut Handle
IO.stdout (forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> Char -> ByteStream m r
snoc ByteStream m r
bs Char
'\n')
{-# INLINE putStrLn #-}

-- | Bounds for Word# multiplication by 10 without overflow, and
-- absolute values of Int bounds.
intmaxWord, intminWord, intmaxQuot10, intmaxRem10, intminQuot10, intminRem10 :: Word
intmaxWord :: Word
intmaxWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
intminWord :: Word
intminWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
negate (forall a. Bounded a => a
minBound :: Int))
(Word
intmaxQuot10, Word
intmaxRem10) = Word
intmaxWord forall a. Integral a => a -> a -> (a, a)
`quotRem` Word
10
(Word
intminQuot10, Word
intminRem10) = Word
intminWord forall a. Integral a => a -> a -> (a, a)
`quotRem` Word
10

-- Predicate to test whether a 'Word8' value is either ASCII whitespace,
-- or a unicode NBSP (U+00A0).  Optimised for ASCII text, with spaces
-- as the most frequent whitespace characters.
w8IsSpace :: Word8 -> Bool
w8IsSpace :: Word8 -> Bool
w8IsSpace = \ !Word8
w8 ->
    -- Avoid the cost of narrowing arithmetic results to Word8,
    -- the conversion from Word8 to Word is free.
    let w :: Word
        !w :: Word
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
     in Word
w forall a. Bits a => a -> a -> a
.&. Word
0x50 forall a. Eq a => a -> a -> Bool
== Word
0    -- Quick non-wsp filter
        Bool -> Bool -> Bool
&& Word
w forall a. Num a => a -> a -> a
- Word
0x21 forall a. Ord a => a -> a -> Bool
> Word
0x7e -- 2nd non-wsp filter
        Bool -> Bool -> Bool
&& ( Word
w forall a. Eq a => a -> a -> Bool
== Word
0x20     -- SP
          Bool -> Bool -> Bool
|| Word
w forall a. Num a => a -> a -> a
- Word
0x09 forall a. Ord a => a -> a -> Bool
< Word
5  -- HT, NL, VT, FF, CR
          Bool -> Bool -> Bool
|| Word
w forall a. Eq a => a -> a -> Bool
== Word
0xa0 )   -- NBSP
{-# INLINE w8IsSpace #-}

-- | Try to position the stream at the next non-whitespace input, by
-- skipping leading whitespace.  Only a /reasonable/ quantity of
-- whitespace will be skipped before giving up and returning the rest
-- of the stream with any remaining whitespace.  Limiting the amount of
-- whitespace consumed is a safety mechanism to avoid looping forever
-- on a never-ending stream of whitespace from an untrusted source.
-- For unconditional dropping of all leading whitespace, use `dropWhile`
-- with a suitable predicate.
skipSomeWS :: Monad m => ByteStream m r -> ByteStream m r
{-# INLINE skipSomeWS #-}
skipSomeWS :: forall (m :: * -> *) r. Monad m => ByteStream m r -> ByteStream m r
skipSomeWS = forall {m :: * -> *} {r}.
Functor m =>
Int -> ByteStream m r -> ByteStream m r
go Int
0
  where
    go :: Int -> ByteStream m r -> ByteStream m r
go !Int
n (Chunk ByteString
c ByteStream m r
cs)
        | ByteString
k <- (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
w8IsSpace ByteString
c
        , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.null ByteString
k        = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
k ByteStream m r
cs
        | Int
n' <- Int
n forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
c
        , Int
n' forall a. Ord a => a -> a -> Bool
< Int
defaultChunkSize = Int -> ByteStream m r -> ByteStream m r
go Int
n' ByteStream m r
cs
        | Bool
otherwise = ByteStream m r
cs
    go !Int
n (Go m (ByteStream m r)
m)                = forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
Go forall a b. (a -> b) -> a -> b
$ Int -> ByteStream m r -> ByteStream m r
go Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ByteStream m r)
m
    go Int
_ ByteStream m r
r                      = ByteStream m r
r

-- | Try to read an 'Int' value from the 'ByteString', returning
-- @m (Compose (Just val :> str))@ on success, where @val@ is the value
-- read and @str@ is the rest of the input stream.  If the stream of
-- digits decodes to a value larger than can be represented by an 'Int',
-- the returned value will be @m (Compose (Nothing :> str))@, where the
-- content of @str@ is the same as the original stream, but some of the
-- monadic effects may already have taken place, so the original stream
-- MUST NOT be used.  To read the remaining data, you MUST use the
-- returned @str@.
--
-- This function will not read an /unreasonably/ long stream of leading
-- zero digits when trying to decode a number.  When reading the first
-- non-zero digit would require requesting a new chunk and ~32KB of
-- leading zeros have already been read, the conversion is aborted and
-- 'Nothing' is returned, along with the overly long run of leading
-- zeros (and any initial explicit plus or minus sign).
--
-- 'readInt' does not ignore leading whitespace, the value must start
-- immediately at the beginning of the input stream.  Use 'skipSomeWS'
-- if you want to skip a /reasonable/ quantity of leading whitespace.
--
-- ==== __Example__
-- >>> getCompose <$> (readInt . skipSomeWS) stream >>= \case
-- >>>     Just n  :> rest -> print n >> gladly rest
-- >>>     Nothing :> rest -> sadly rest
--
readInt :: Monad m
        => ByteStream m r
        -> m (Compose (Of (Maybe Int)) (ByteStream m) r)
{-# INLINABLE readInt #-}
readInt :: forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Compose (Of (Maybe Int)) (ByteStream m) r)
readInt = forall {a} {m :: * -> *} {a}.
(Num a, Monad m) =>
ByteStream m a -> m (Compose (Of (Maybe a)) (ByteStream m) a)
start
  where
    nada :: g a -> m (Compose (Of (Maybe a)) g a)
nada g a
str = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing forall a b. a -> b -> Of a b
:> g a
str

    start :: ByteStream m a -> m (Compose (Of (Maybe a)) (ByteStream m) a)
start bs :: ByteStream m a
bs@(Chunk ByteString
c ByteStream m a
cs)
        | ByteString -> Bool
B.null ByteString
c = ByteStream m a -> m (Compose (Of (Maybe a)) (ByteStream m) a)
start ByteStream m a
cs
        | Word8
w <- ByteString -> Word8
B.unsafeHead ByteString
c
          = if | Word8
w forall a. Num a => a -> a -> a
- Word8
0x30 forall a. Ord a => a -> a -> Bool
<= Word8
9 -> forall {a} {m :: * -> *} {a}.
(Num a, Monad m) =>
Bool
-> Maybe Word8
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
readDec Bool
True forall a. Maybe a
Nothing ByteStream m a
bs
               | let rest :: ByteStream m a
rest = forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (HasCallStack => ByteString -> ByteString
B.tail ByteString
c) ByteStream m a
cs
                 -> if | Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x2b -> forall {a} {m :: * -> *} {a}.
(Num a, Monad m) =>
Bool
-> Maybe Word8
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
readDec Bool
True  (forall a. a -> Maybe a
Just Word8
w) ByteStream m a
rest
                       | Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0x2d -> forall {a} {m :: * -> *} {a}.
(Num a, Monad m) =>
Bool
-> Maybe Word8
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
readDec Bool
False (forall a. a -> Maybe a
Just Word8
w) ByteStream m a
rest
                       | Bool
otherwise -> forall {m :: * -> *} {g :: * -> *} {a} {a}.
Monad m =>
g a -> m (Compose (Of (Maybe a)) g a)
nada ByteStream m a
bs
    start (Go m (ByteStream m a)
m) = m (ByteStream m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteStream m a -> m (Compose (Of (Maybe a)) (ByteStream m) a)
start
    start bs :: ByteStream m a
bs@(Empty a
_) = forall {m :: * -> *} {g :: * -> *} {a} {a}.
Monad m =>
g a -> m (Compose (Of (Maybe a)) g a)
nada ByteStream m a
bs

    -- | Read an 'Int' without overflow.  If an overflow is about to take
    -- place or no number is found, the original input is recovered from any
    -- initial explicit sign, the accumulated pre-overflow value and the
    -- number of digits consumed prior to overflow detection.
    --
    -- In order to avoid reading an unreasonable number of zero bytes before
    -- ultimately reporting an overflow, a limit of ~32kB is imposed on the
    -- number of bytes to read before giving up on /unreasonably long/ input
    -- that is padded with so many zeros, that it could only be a memory
    -- exhaustion attack.  Callers who want to trim very long runs of
    -- zeros could note the sign, and skip leading zeros before calling
    -- function.  Few if any should want that.
    {-# INLINE readDec #-}
    readDec :: Bool
-> Maybe Word8
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
readDec !Bool
positive Maybe Word8
signByte = forall {a} {m :: * -> *} {a}.
(Num a, Monad m) =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
loop Int
0 Word
0
      where
        loop :: Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
loop !Int
nbytes !Word
acc = \ ByteStream m a
str -> case ByteStream m a
str of
            Empty a
_ -> forall {a} {m :: * -> *} {m :: * -> *} {a}.
(Num a, Monad m) =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
result Int
nbytes Word
acc ByteStream m a
str
            Go m (ByteStream m a)
m    -> m (ByteStream m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
loop Int
nbytes Word
acc
            Chunk ByteString
c ByteStream m a
cs
                | !Int
l <- ByteString -> Int
B.length ByteString
c
                , Int
l forall a. Ord a => a -> a -> Bool
> Int
0 -> case Word -> ByteString -> (Int, Word, Bool)
accumWord Word
acc ByteString
c of
                     (Int
0, !Word
_, !Bool
inrange)
                         | Bool
inrange
                           -- no more digits found
                           -> forall {a} {m :: * -> *} {m :: * -> *} {a}.
(Num a, Monad m) =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
result Int
nbytes Word
acc ByteStream m a
str
                         | Bool
otherwise
                           -- Overlow on first digit of chunk
                           -> forall {m :: * -> *} {m :: * -> *} {a} {a}.
Monad m =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
overflow Int
nbytes Word
acc ByteStream m a
str
                     (!Int
n, !Word
a, !Bool
inrange)
                         | Bool
False <- Bool
inrange
                           -- result out of 'Int' range
                           -> forall {m :: * -> *} {m :: * -> *} {a} {a}.
Monad m =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
overflow Int
nbytes Word
acc ByteStream m a
str
                         | Int
n forall a. Ord a => a -> a -> Bool
< Int
l, !ByteString
t <- Int -> ByteString -> ByteString
B.drop Int
n ByteString
c
                           -- input not entirely digits
                           -> forall {a} {m :: * -> *} {m :: * -> *} {a}.
(Num a, Monad m) =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
result (Int
nbytes forall a. Num a => a -> a -> a
+ Int
n) Word
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
t ByteStream m a
cs
                         | Word
a forall a. Ord a => a -> a -> Bool
> Word
0 Bool -> Bool -> Bool
|| Int
nbytes forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
< Int
defaultChunkSize
                           -- if all zeros, not yet too many
                           -> Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
loop (Int
nbytes forall a. Num a => a -> a -> a
+ Int
n) Word
a ByteStream m a
cs
                         | Bool
otherwise
                           -- too many zeros, bail out with sign
                           -> forall {m :: * -> *} {m :: * -> *} {a} {a}.
Monad m =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
overflow Int
nbytes Word
acc ByteStream m a
str
                | Bool
otherwise
                           -- skip empty segment
                           -> Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
loop Int
nbytes Word
acc ByteStream m a
cs

        -- | Process as many digits as we can, returning the additional
        -- number of digits found, the updated accumulater, and whether
        -- the input decimal did not overflow prior to processing all
        -- the provided digits (end of input or non-digit encountered).
        accumWord :: Word -> ByteString -> (Int, Word, Bool)
accumWord Word
acc (B.PS ForeignPtr Word8
fp Int
off Int
len) =
            forall a. IO a -> a
B.accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ do
                forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
                    let ptr :: Ptr b
ptr = Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
                        end :: Ptr b
end = forall a. Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
                    x :: (Int, Word, Bool)
x@(!Int
_, !Word
_, !Bool
_) <- if Bool
positive
                        then Word
-> Word
-> Ptr Word8
-> Ptr Word8
-> Int
-> Word
-> IO (Int, Word, Bool)
digits Word
intmaxQuot10 Word
intmaxRem10 forall a. Ptr a
end forall a. Ptr a
ptr Int
0 Word
acc
                        else Word
-> Word
-> Ptr Word8
-> Ptr Word8
-> Int
-> Word
-> IO (Int, Word, Bool)
digits Word
intminQuot10 Word
intminRem10 forall a. Ptr a
end forall a. Ptr a
ptr Int
0 Word
acc
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Word, Bool)
x
          where
            digits :: Word
-> Word
-> Ptr Word8
-> Ptr Word8
-> Int
-> Word
-> IO (Int, Word, Bool)
digits !Word
maxq !Word
maxr !Ptr Word8
e !Ptr Word8
ptr = Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool)
go Ptr Word8
ptr
              where
                go :: Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool)
                go :: Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool)
go !Ptr Word8
p !Int
b !Word
a | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== Ptr Word8
e = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
b, Word
a, Bool
True)
                go !Ptr Word8
p !Int
b !Word
a = do
                    !Word8
byte <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
                    let !w :: Word8
w = Word8
byte forall a. Num a => a -> a -> a
- Word8
0x30
                        !d :: Word
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
                    if | Word8
w forall a. Ord a => a -> a -> Bool
> Word8
9
                         -- No more digits
                         -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
b, Word
a, Bool
True)
                       | Word
a forall a. Ord a => a -> a -> Bool
< Word
maxq
                         -- Look for more
                         -> Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool)
go (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
b forall a. Num a => a -> a -> a
+ Int
1) (Word
a forall a. Num a => a -> a -> a
* Word
10 forall a. Num a => a -> a -> a
+ Word
d)
                       | Word
a forall a. Ord a => a -> a -> Bool
> Word
maxq
                         -- overflow
                         -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
b, Word
a, Bool
False)
                       | Word
d forall a. Ord a => a -> a -> Bool
<= Word
maxr
                         -- Ideally this will be the last digit
                         -> Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool)
go (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
b forall a. Num a => a -> a -> a
+ Int
1) (Word
a forall a. Num a => a -> a -> a
* Word
10 forall a. Num a => a -> a -> a
+ Word
d)
                       | Bool
otherwise
                         -- overflow
                         -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
b, Word
a, Bool
False)

        -- | Plausible success, provided we got at least one digit!
        result :: Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
result !Int
nbytes !Word
acc ByteStream m a
str
            | Int
nbytes forall a. Ord a => a -> a -> Bool
> Int
0, !a
i <- forall a b. (Integral a, Num b) => a -> b
w2int Word
acc = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
i forall a b. a -> b -> Of a b
:> ByteStream m a
str
            | Bool
otherwise = forall {m :: * -> *} {m :: * -> *} {a} {a}.
Monad m =>
Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
overflow Int
nbytes Word
acc ByteStream m a
str -- just the sign perhaps?

        -- This assumes that @negate . fromIntegral@ correctly produces
        -- @minBound :: Int@ when given its positive 'Word' value as an
        -- input.  This is true in both 2s-complement and 1s-complement
        -- arithmetic, so seems like a safe bet.  Tests cover this case,
        -- though the CI may not run on sufficiently exotic CPUs.
        w2int :: a -> b
w2int !a
n | Bool
positive = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
                 | Bool
otherwise = forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n

        -- | Reconstruct any consumed input, and report failure
        overflow :: Int
-> Word
-> ByteStream m a
-> m (Compose (Of (Maybe a)) (ByteStream m) a)
overflow Int
0 Word
_ ByteStream m a
str = case Maybe Word8
signByte of
            Maybe Word8
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing forall a b. a -> b -> Of a b
:> ByteStream m a
str
            Just Word8
w  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing forall a b. a -> b -> Of a b
:> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk (Word8 -> ByteString
B.singleton Word8
w) ByteStream m a
str
        overflow !Int
nbytes !Word
acc ByteStream m a
str =
            let !c :: ByteString
c = Int -> Word -> ByteString
overflowBytes Int
nbytes Word
acc
             in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing forall a b. a -> b -> Of a b
:> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
c ByteStream m a
str

        -- | Reconstruct an @nbytes@-byte prefix consisting of digits
        -- from the accumulated value @acc@, with sufficiently many
        -- leading zeros to match the original input length.  This
        -- relies on decimal numbers (leading zeros aside) having a
        -- unique representation.  Doing this for potentially mixed-case
        -- hexadecimal input would require holding on to the input data,
        -- which would noticeably hurt performance.
        overflowBytes :: Int -> Word -> B.ByteString
        overflowBytes :: Int -> Word -> ByteString
overflowBytes !Int
nbytes !Word
acc =
            Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (Int
nbytes forall a. Num a => a -> a -> a
+ Int
signlen) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
                let end :: Ptr b
end = Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
signlen forall a. Num a => a -> a -> a
- Int
1)
                    ptr :: Ptr b
ptr = Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
nbytes forall a. Num a => a -> a -> a
+ Int
signlen forall a. Num a => a -> a -> a
- Int
1)
                Ptr Word8 -> Ptr Word8 -> Word -> IO ()
go forall a. Ptr a
end forall a. Ptr a
ptr Word
acc
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p) Maybe Word8
signByte
          where
            signlen :: Int
signlen = if Maybe Word8
signByte forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing then Int
0 else Int
1

            go :: Ptr Word8 -> Ptr Word8 -> Word -> IO ()
            go :: Ptr Word8 -> Ptr Word8 -> Word -> IO ()
go Ptr Word8
end !Ptr Word8
ptr !Word
_ | Ptr Word8
end forall a. Eq a => a -> a -> Bool
== Ptr Word8
ptr = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            go Ptr Word8
end !Ptr Word8
ptr !Word
a = do
                let (Word
q, Word
r) = Word
a forall a. Integral a => a -> a -> (a, a)
`quotRem` Word
10
                forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r forall a. Num a => a -> a -> a
+ Word8
0x30
                Ptr Word8 -> Ptr Word8 -> Word -> IO ()
go Ptr Word8
end (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) Word
q