diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,46 @@ +## 0.1.7 (2020-10-14) + +Thanks to Viktor Dukhovni and Colin Woodbury for their contributions to this release. + +#### Added + +- The `skipSomeWS` function for efficiently skipping leading whitespace of both + ASCII and non-ASCII. + +#### Changed + +- **The `ByteString` type has been renamed to `ByteStream`**. This fixes a + well-reported confusion from users. An alias to the old name has been provided + for back-compatibility, but is deprecated and be removed in the next major + release. +- **Modules have been renamed** to match the precedent set by the main + `streaming` library. Aliases to the old names have been provided, but will be + removed in the next major release. + - `Data.ByteString.Streaming` -> `Streaming.ByteString` + - `Data.ByteString.Streaming.Char8` -> `Streaming.ByteString.Char8` +- An order-of-magnitude performance improvement in line splitting. [#18] +- Performance and correctness improvements for the `readInt` function. [#31] +- Documentation improved, and docstring coverage is now 100%. [#27] + +#### Fixed + +- An incorrect comment about `Handle`s being automatically closed upon EOF with + `hGetContents` and `hGetContentsN`. [#9] +- A crash in `group` and `groupBy` when reading too many bytes. [#22] +- `groupBy` incorrectly ordering its output elements. [#4] + +[#9]: https://github.com/haskell-streaming/streaming-bytestring/issues/9 +[#18]: https://github.com/haskell-streaming/streaming-bytestring/pull/18 +[#22]: https://github.com/haskell-streaming/streaming-bytestring/pull/22 +[#4]: https://github.com/haskell-streaming/streaming-bytestring/issues/4 +[#27]: https://github.com/haskell-streaming/streaming-bytestring/pull/27 +[#31]: https://github.com/haskell-streaming/streaming-bytestring/pull/31 + +## 0.1.6 + +- `Semigroup` instance for `ByteString m r` added +- New function `lineSplit` + +## 0.1.5 + +- Update for `streaming-0.2` diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,8 +0,0 @@ -## 0.1.6 - -- `Semigroup` instance for `ByteString m r` added -- New function `lineSplit` - -## 0.1.5 - -- Update for `streaming-0.2` diff --git a/Data/ByteString/Streaming.hs b/Data/ByteString/Streaming.hs deleted file mode 100644 --- a/Data/ByteString/Streaming.hs +++ /dev/null @@ -1,1793 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns #-} -{-#LANGUAGE RankNTypes, GADTs #-} --- This library emulates Data.ByteString.Lazy but includes a monadic element --- and thus at certain points uses a `Stream`/`FreeT` type in place of lists. - --- | --- Module : Data.ByteString.Streaming --- Copyright : (c) Don Stewart 2006 --- (c) Duncan Coutts 2006-2011 --- (c) Michael Thompson 2015 --- License : BSD-style --- --- Maintainer : what_is_it_to_do_anything@yahoo.com --- Stability : experimental --- Portability : portable --- --- See the simple examples of use --- and the @ghci@ examples especially in "Data.ByteString.Streaming.Char8". --- We begin with a slight modification of the documentation to "Data.ByteString.Lazy": --- --- A time and space-efficient implementation of effectful byte streams --- using a stream of packed 'Word8' arrays, suitable for high performance --- use, both in terms of large data quantities, or high speed --- requirements. Streaming ByteStrings are encoded as streams of strict chunks --- of bytes. --- --- A key feature of streaming ByteStrings is the means to manipulate large or --- unbounded streams of data without requiring the entire sequence to be --- resident in memory. To take advantage of this you have to write your --- functions in a streaming style, e.g. classic pipeline composition. The --- default I\/O chunk size is 32k, which should be good in most circumstances. --- --- Some operations, such as 'concat', 'append', 'reverse' and 'cons', have --- better complexity than their "Data.ByteString" equivalents, due to --- optimisations resulting from the list spine structure. For other --- operations streaming, like lazy, ByteStrings are usually within a few percent of --- strict ones. --- --- This module is intended to be imported @qualified@, to avoid name --- clashes with "Prelude" functions. eg. --- --- > import qualified Data.ByteString.Streaming as B --- --- Original GHC implementation by Bryan O\'Sullivan. --- Rewritten to use 'Data.Array.Unboxed.UArray' by Simon Marlow. --- Rewritten to support slices and use 'Foreign.ForeignPtr.ForeignPtr' --- by David Roundy. --- Rewritten again and extended by Don Stewart and Duncan Coutts. --- Lazy variant by Duncan Coutts and Don Stewart. --- Streaming variant by Michael Thompson, following the ideas of Gabriel Gonzales' --- pipes-bytestring --- -module Data.ByteString.Streaming ( - -- * The @ByteString@ type - ByteString - - -- * Introducing and eliminating 'ByteString's - , empty -- empty :: ByteString m () - , singleton -- singleton :: Monad m => Word8 -> ByteString m () - , pack -- pack :: Monad m => Stream (Of Word8) m r -> ByteString m r - , unpack -- unpack :: Monad m => ByteString m r -> Stream (Of Word8) m r - , fromLazy -- fromLazy :: Monad m => ByteString -> ByteString m () - , toLazy -- toLazy :: Monad m => ByteString m () -> m ByteString - , toLazy_ -- toLazy' :: Monad m => ByteString m () -> m (Of ByteString r) - , fromChunks -- fromChunks :: Monad m => Stream (Of ByteString) m r -> ByteString m r - , toChunks -- toChunks :: Monad m => ByteString m r -> Stream (Of ByteString) m r - , fromStrict -- fromStrict :: ByteString -> ByteString m () - , toStrict -- toStrict :: Monad m => ByteString m () -> m ByteString - , toStrict_ -- toStrict_ :: Monad m => ByteString m r -> m (Of ByteString r) - , effects - , copy - , drained - , mwrap - , distribute -- distribute :: ByteString (t m) a -> t (ByteString m) a - - - -- * Transforming ByteStrings - , map -- map :: Monad m => (Word8 -> Word8) -> ByteString m r -> ByteString m r - , intercalate -- intercalate :: Monad m => ByteString m () -> Stream (ByteString m) m r -> ByteString m r - , intersperse -- intersperse :: Monad m => Word8 -> ByteString m r -> ByteString m r - - -- * Basic interface - , cons -- cons :: Monad m => Word8 -> ByteString m r -> ByteString m r - , cons' -- cons' :: Word8 -> ByteString m r -> ByteString m r - , snoc - , append -- append :: Monad m => ByteString m r -> ByteString m s -> ByteString m s - , filter -- filter :: (Word8 -> Bool) -> ByteString m r -> ByteString m r - , uncons -- uncons :: Monad m => ByteString m r -> m (Either r (Word8, ByteString m r)) - , nextByte -- nextByte :: Monad m => ByteString m r -> m (Either r (Word8, ByteString m r)) - , denull - - -- * Substrings - - -- ** Breaking strings - , break -- break :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m (ByteString m r) - , drop -- drop :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m r - , dropWhile - , group -- group :: Monad m => ByteString m r -> Stream (ByteString m) m r - , groupBy - , span -- span :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m (ByteString m r) - , splitAt -- splitAt :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m (ByteString m r) - , splitWith -- splitWith :: Monad m => (Word8 -> Bool) -> ByteString m r -> Stream (ByteString m) m r - , take -- take :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m () - , takeWhile -- takeWhile :: (Word8 -> Bool) -> ByteString m r -> ByteString m () - - -- ** Breaking into many substrings - , split -- split :: Monad m => Word8 -> ByteString m r -> Stream (ByteString m) m r - - -- ** Special folds - - , concat -- concat :: Monad m => Stream (ByteString m) m r -> ByteString m r - - -- * Builders - - , toStreamingByteStringWith - , toStreamingByteString - , toBuilder - , concatBuilders - - -- * Building ByteStrings - - -- ** Infinite ByteStrings - , repeat -- repeat :: Word8 -> ByteString m r - , iterate -- iterate :: (Word8 -> Word8) -> Word8 -> ByteString m r - , cycle -- cycle :: Monad m => ByteString m r -> ByteString m s - - -- ** Unfolding ByteStrings - , unfoldM -- unfoldr :: (a -> m (Maybe (Word8, a))) -> m a -> ByteString m () - , unfoldr -- unfold :: (a -> Either r (Word8, a)) -> a -> ByteString m r - , reread - - -- * Folds, including support for `Control.Foldl` - , foldr -- foldr :: Monad m => (Word8 -> a -> a) -> a -> ByteString m () -> m a - , fold -- fold :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteString m () -> m b - , fold_ -- fold' :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteString m r -> m (b, r) - - , head - , head_ - , last - , last_ - , length - , length_ - , null - , null_ - , nulls - , testNull - , count - , count_ - -- * I\/O with 'ByteString's - - -- ** Standard input and output - , getContents -- getContents :: ByteString IO () - , stdin -- stdin :: ByteString IO () - , stdout -- stdout :: ByteString IO r -> IO r - , interact -- interact :: (ByteString IO () -> ByteString IO r) -> IO r - - -- ** Files - , readFile -- readFile :: FilePath -> ByteString IO () - , writeFile -- writeFile :: FilePath -> ByteString IO r -> IO r - , appendFile -- appendFile :: FilePath -> ByteString IO r -> IO r - - -- ** I\/O with Handles - , fromHandle -- fromHandle :: Handle -> ByteString IO () - , toHandle -- toHandle :: Handle -> ByteString IO r -> IO r - , hGet -- hGet :: Handle -> Int -> ByteString IO () - , hGetContents -- hGetContents :: Handle -> ByteString IO () - , hGetContentsN -- hGetContentsN :: Int -> Handle -> ByteString IO () - , hGetN -- hGetN :: Int -> Handle -> Int -> ByteString IO () - , hGetNonBlocking -- hGetNonBlocking :: Handle -> Int -> ByteString IO () - , hGetNonBlockingN -- hGetNonBlockingN :: Int -> Handle -> Int -> ByteString IO () - , hPut -- hPut :: Handle -> ByteString IO r -> IO r --- , hPutNonBlocking -- hPutNonBlocking :: Handle -> ByteString IO r -> ByteString IO r - -- * Etc. - , zipWithStream -- zipWithStream :: Monad m => (forall x. a -> ByteString m x -> ByteString m x) -> [a] -> Stream (ByteString m) m r -> Stream (ByteString m) m r - - -- * Simple chunkwise operations - , unconsChunk - , nextChunk - , chunk - , foldrChunks - , foldlChunks - , chunkFold - , chunkFoldM - , chunkMap - , chunkMapM - , chunkMapM_ - ) where - -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,maximum - ,minimum,all,concatMap,foldl1,foldr1,scanl, scanl1, scanr, scanr1 - ,repeat, cycle, interact, iterate,readFile,writeFile,appendFile,replicate - ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) -import qualified Prelude -import qualified Data.List as L -- L for list/lazy -import qualified Data.ByteString.Lazy.Internal as BI -- just for fromChunks etc - -import qualified Data.ByteString as P (ByteString) -- type name only -import qualified Data.ByteString as S -- S for strict (hmm...) -import qualified Data.ByteString.Internal as S -import qualified Data.ByteString.Unsafe as S -import Data.ByteString.Builder.Internal hiding (hPut, defaultChunkSize, empty, append) - -import Data.ByteString.Streaming.Internal -import Streaming hiding (concats, unfold, distribute, mwrap) -import Streaming.Internal (Stream (..)) -import qualified Streaming.Prelude as SP - - -import Control.Monad (liftM, forever) -import Data.Monoid (Monoid(..)) -import Data.Word (Word8) -import Data.Int (Int64) -import System.IO (Handle,openBinaryFile,IOMode(..) - ,hClose) -import qualified System.IO as IO (stdin, stdout) -import System.IO.Error (mkIOError, illegalOperationErrorType) -import Control.Exception (bracket) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Storable -import Foreign.Ptr -import Data.Functor.Compose -import Data.Functor.Sum -import Control.Monad.Trans.Resource - --- | /O(n)/ Concatenate a stream of byte streams. -concat :: Monad m => Stream (ByteString m) m r -> ByteString m r -concat x = destroy x join Go Empty -{-# INLINE concat #-} - --- | Given a byte stream on a transformed monad, make it possible to \'run\' --- transformer. -distribute - :: (Monad m, MonadTrans t, MFunctor t, Monad (t m), Monad (t (ByteString m))) - => ByteString (t m) a -> t (ByteString m) a -distribute ls = dematerialize ls - return - (\bs x -> join $ lift $ Chunk bs (Empty x) ) - (join . hoist (Go . liftM Empty)) -{-# INLINE distribute #-} - -{-| Perform the effects contained in an effectful bytestring, ignoring the bytes. - --} -effects :: Monad m => ByteString m r -> m r -effects bs = case bs of - Empty r -> return r - Go m -> m >>= effects - Chunk _ rest -> effects rest -{-# INLINABLE effects #-} - - -{-| Perform the effects contained in the second in an effectful pair of bytestrings, - ignoring the bytes. It would typically be used at the type - -> ByteString m (ByteString m r) -> ByteString m r - --} - -drained :: (Monad m, MonadTrans t, Monad (t m)) => t m (ByteString m r) -> t m r -drained t = t >>= lift . effects --- ----------------------------------------------------------------------------- --- Introducing and eliminating 'ByteString's - -{-| /O(1)/ The empty 'ByteString' -- i.e. @return ()@ Note that @ByteString m w@ is - generally a monoid for monoidal values of @w@, like @()@ --} -empty :: ByteString m () -empty = Empty () -{-# INLINE empty #-} - -{-| /O(1)/ Yield a 'Word8' as a minimal 'ByteString' --} -singleton :: Monad m => Word8 -> ByteString m () -singleton w = Chunk (S.singleton w) (Empty ()) -{-# INLINE singleton #-} - -{-| /O(n)/ Convert a monadic stream of individual 'Word8's into a packed byte stream. --} -pack :: Monad m => Stream (Of Word8) m r -> ByteString m r -pack = packBytes -{-#INLINE pack #-} - -{-| /O(n)/ Converts a packed byte stream into a stream of individual bytes. --} -unpack :: Monad m => ByteString m r -> Stream (Of Word8) m r -unpack = unpackBytes - -{-| /O(c)/ Convert a monadic stream of individual strict 'ByteString' - chunks into a byte stream. --} -fromChunks :: Monad m => Stream (Of P.ByteString) m r -> ByteString m r -fromChunks cs = destroy cs - (\(bs :> rest) -> Chunk bs rest) - Go - return -{-#INLINE fromChunks#-} - -{-| /O(c)/ Convert a byte stream into a stream of individual strict bytestrings. - This of course exposes the internal chunk structure. --} -toChunks :: Monad m => ByteString m r -> Stream (Of P.ByteString) m r -toChunks bs = - dematerialize bs - return - (\b mx -> Step (b:> mx)) - Effect -{-#INLINE toChunks#-} - -{-| /O(1)/ yield a strict 'ByteString' chunk. --} -fromStrict :: P.ByteString -> ByteString m () -fromStrict bs | S.null bs = Empty () - | otherwise = Chunk bs (Empty ()) -{-# INLINE fromStrict #-} - -{-| /O(n)/ Convert a byte stream into a single strict 'ByteString'. - - Note that this is an /expensive/ operation that forces the whole monadic - ByteString into memory and then copies all the data. If possible, try to - avoid converting back and forth between streaming and strict bytestrings. --} -toStrict_ :: Monad m => ByteString m () -> m (S.ByteString) -toStrict_ = liftM S.concat . SP.toList_ . toChunks -{-# INLINE toStrict_ #-} - - -{-| /O(n)/ Convert a monadic byte stream into a single strict 'ByteString', - retaining the return value of the original pair. This operation is - for use with 'mapped'. - -> mapped R.toStrict :: Monad m => Stream (ByteString m) m r -> Stream (Of ByteString) m r - - It is subject to all the objections one makes to Data.ByteString.Lazy 'toStrict'; - all of these are devastating. --} -toStrict :: Monad m => ByteString m r -> m (Of S.ByteString r) -toStrict bs = do - (bss :> r) <- SP.toList (toChunks bs) - return $ (S.concat bss :> r) -{-# INLINE toStrict #-} - -{- |/O(c)/ Transmute a pseudo-pure lazy bytestring to its representation - as a monadic stream of chunks. - ->>> Q.putStrLn $ Q.fromLazy "hi" -hi ->>> Q.fromLazy "hi" -Chunk "hi" (Empty (())) -- note: a 'show' instance works in the identity monad ->>> Q.fromLazy $ BL.fromChunks ["here", "are", "some", "chunks"] -Chunk "here" (Chunk "are" (Chunk "some" (Chunk "chunks" (Empty (()))))) - --} -fromLazy :: Monad m => BI.ByteString -> ByteString m () -fromLazy = BI.foldrChunks Chunk (Empty ()) -{-# INLINE fromLazy #-} - -{-| /O(n)/ Convert an effectful byte stream into a single lazy 'ByteString' - with the same internal chunk structure. See @toLazy@ which preserve - connectedness by keeping the return value of the effectful bytestring. - --} -toLazy_ :: Monad m => ByteString m r -> m BI.ByteString -toLazy_ bs = dematerialize bs - (\_ -> return (BI.Empty)) - (\b mx -> liftM (BI.Chunk b) mx) - join -{-#INLINE toLazy_ #-} - -{-| /O(n)/ Convert an effectful byte stream into a single lazy 'ByteString' - with the same internal chunk structure, retaining the original - return value. - - This is the canonical way of breaking streaming (@toStrict@ and the - like are far more demonic). Essentially one is dividing the interleaved - layers of effects and bytes into one immense layer of effects, - followed by the memory of the succession of bytes. - - Because one preserves the return value, @toLazy@ is a suitable argument - for 'Streaming.mapped' - -> S.mapped Q.toLazy :: Stream (ByteString m) m r -> Stream (Of L.ByteString) m r - ->>> Q.toLazy "hello" -"hello" :> () ->>> S.toListM $ traverses Q.toLazy $ Q.lines "one\ntwo\nthree\nfour\nfive\n" -["one","two","three","four","five",""] -- [L.ByteString] - --} -toLazy :: Monad m => ByteString m r -> m (Of BI.ByteString r) -toLazy bs0 = dematerialize bs0 - (\r -> return (BI.Empty :> r)) - (\b mx -> do - (bs :> x) <- mx - return $ BI.Chunk b bs :> x - ) - join -{-#INLINE toLazy #-} - - - - --- --------------------------------------------------------------------- --- Basic interface --- - -{- | Test whether a ByteString is empty, collecting its return value; --- to reach the return value, this operation must check the whole length of the string. - ->>> Q.null "one\ntwo\three\nfour\nfive\n" -False :> () ->>> Q.null "" -True :> () ->>> S.print $ mapped R.null $ Q.lines "yours,\nMeredith" -False -False - --} -null :: Monad m => ByteString m r -> m (Of Bool r) -null (Empty r) = return (True :> r) -null (Go m) = m >>= null -null (Chunk bs rest) = if S.null bs - then null rest - else do - r <- SP.effects (toChunks rest) - return (False :> r) -{-# INLINABLE null #-} - -{-| /O(1)/ Test whether an ByteString is empty. The value is of course in - the monad of the effects. - ->>> Q.null "one\ntwo\three\nfour\nfive\n" -False ->>> Q.null $ Q.take 0 Q.stdin -True ->>> :t Q.null $ Q.take 0 Q.stdin -Q.null $ Q.take 0 Q.stdin :: MonadIO m => m Bool --} -null_ :: Monad m => ByteString m r -> m Bool -null_ (Empty _) = return True -null_ (Go m) = m >>= null_ -null_ (Chunk bs rest) = if S.null bs - then null_ rest - else return False -{-# INLINABLE null_ #-} - - -testNull :: Monad m => ByteString m r -> m (Of Bool (ByteString m r)) -testNull (Empty r) = return (True :> Empty r) -testNull (Go m) = m >>= testNull -testNull p@(Chunk bs rest) = if S.null bs - then testNull rest - else return (False :> p) -{-# INLINABLE testNull #-} - -{-| Remove empty ByteStrings from a stream of bytestrings. - --} -denull :: Monad m => Stream (ByteString m) m r -> Stream (ByteString m) m r -denull = hoist (run . maps effects) . separate . mapped nulls -{-#INLINE denull #-} - - - -{-| /O1/ Distinguish empty from non-empty lines, while maintaining streaming; - the empty ByteStrings are on the right - ->>> nulls :: ByteString m r -> m (Sum (ByteString m) (ByteString m) r) - - There are many ways to remove null bytestrings from a - @Stream (ByteString m) m r@ (besides using @denull@). If we pass next to - ->>> mapped nulls bs :: Stream (Sum (ByteString m) (ByteString m)) m r - - then can then apply @Streaming.separate@ to get - ->>> separate (mapped nulls bs) :: Stream (ByteString m) (Stream (ByteString m) m) r - - The inner monad is now made of the empty bytestrings; we act on this - with @hoist@ , considering that - ->>> :t Q.effects . Q.concat -Q.effects . Q.concat - :: Monad m => Stream (Q.ByteString m) m r -> m r - - we have - ->>> hoist (Q.effects . Q.concat) . separate . mapped Q.nulls - :: Monad n => Stream (Q.ByteString n) n b -> Stream (Q.ByteString n) n b - - - --} - -nulls :: Monad m => ByteString m r -> m (Sum (ByteString m) (ByteString m) r) -nulls (Empty r) = return (InR (return r)) -nulls (Go m) = m >>= nulls -nulls (Chunk bs rest) = if S.null bs - then nulls rest - else return (InL (Chunk bs rest)) -{-# INLINABLE nulls #-} - - -length_ :: Monad m => ByteString m r -> m Int -length_ = liftM (\(n:> _) -> n) . foldlChunks (\n c -> n + fromIntegral (S.length c)) 0 -{-# INLINE length_ #-} - -{-| /O(n\/c)/ 'length' returns the length of a byte stream as an 'Int' - together with the return value. This makes various maps possible - ->>> Q.length "one\ntwo\three\nfour\nfive\n" -23 :> () ->>> S.print $ S.take 3 $ mapped Q.length $ Q.lines "one\ntwo\three\nfour\nfive\n" -3 -8 -4 --} -length :: Monad m => ByteString m r -> m (Of Int r) -length cs = foldlChunks (\n c -> n + fromIntegral (S.length c)) 0 cs -{-# INLINE length #-} - --- infixr 5 `cons` -- , `cons'` --same as list (:) --- -- nfixl 5 `snoc` --- --- | /O(1)/ 'cons' is analogous to '(:)' for lists. --- -cons :: Monad m => Word8 -> ByteString m r -> ByteString m r -cons c cs = Chunk (S.singleton c) cs -{-# INLINE cons #-} - --- | /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 byte streams. --- -cons' :: Word8 -> ByteString m r -> ByteString m r -cons' w (Chunk c cs) | S.length c < 16 = Chunk (S.cons w c) cs -cons' w cs = Chunk (S.singleton w) cs -{-# INLINE cons' #-} --- -- --- | /O(n\/c)/ Append a byte to the end of a 'ByteString' -snoc :: Monad m => ByteString m r -> Word8 -> ByteString m r -snoc cs w = do -- cs <* singleton w - r <- cs - singleton w - return r -{-# INLINE snoc #-} - --- | /O(1)/ Extract the first element of a 'ByteString', which must be non-empty. -head_ :: Monad m => ByteString m r -> m Word8 -head_ (Empty _) = error "head" -head_ (Chunk c bs) = if S.null c - then head_ bs - else return $ S.unsafeHead c -head_ (Go m) = m >>= head_ -{-# INLINABLE head_ #-} - --- | /O(c)/ Extract the first element of a 'ByteString', which must be non-empty. -head :: Monad m => ByteString m r -> m (Of (Maybe Word8) r) -head (Empty r) = return (Nothing :> r) -head (Chunk c rest) = case S.uncons c of - Nothing -> head rest - Just (w,_) -> do - r <- SP.effects $ toChunks rest - return $! (Just w) :> r -head (Go m) = m >>= head -{-# INLINABLE head #-} - --- | /O(1)/ Extract the head and tail of a 'ByteString', or 'Nothing' --- if it is empty -uncons :: Monad m => ByteString m r -> m (Maybe (Word8, ByteString m r)) -uncons (Empty _) = return Nothing -uncons (Chunk c cs) - = return $ Just (S.unsafeHead c - , if S.length c == 1 - then cs - else Chunk (S.unsafeTail c) cs ) -uncons (Go m) = m >>= uncons -{-# INLINABLE uncons #-} --- --- | /O(1)/ Extract the head and tail of a 'ByteString', or its return value --- if it is empty. This is the \'natural\' uncons for an effectful byte stream. -nextByte :: Monad m => ByteString m r -> m (Either r (Word8, ByteString m r)) -nextByte (Empty r) = return (Left r) -nextByte (Chunk c cs) - = if S.null c - then nextByte cs - else return $ Right (S.unsafeHead c - , if S.length c == 1 - then cs - else Chunk (S.unsafeTail c) cs ) -nextByte (Go m) = m >>= nextByte -{-# INLINABLE nextByte #-} - -unconsChunk :: Monad m => ByteString m r -> m (Maybe (S.ByteString, ByteString m r)) -unconsChunk = \bs -> case bs of - Empty _ -> return Nothing - Chunk c cs -> return (Just (c,cs)) - Go m -> m >>= unconsChunk -{-# INLINABLE unconsChunk #-} - -nextChunk :: Monad m => ByteString m r -> m (Either r (S.ByteString, ByteString m r)) -nextChunk = \bs -> case bs of - Empty r -> return (Left r) - Chunk c cs -> if S.null c - then nextChunk cs - else return (Right (c,cs)) - Go m -> m >>= nextChunk -{-# INLINABLE nextChunk #-} - --- | /O(n\/c)/ Extract the last element of a 'ByteString', which must be finite --- and non-empty. -last_ :: Monad m => ByteString m r -> m Word8 -last_ (Empty _) = error "Data.ByteString.Streaming.last: empty string" -last_ (Go m) = m >>= last_ -last_ (Chunk c0 cs0) = go c0 cs0 - where - go c (Empty _) = if S.null c - then error "Data.ByteString.Streaming.last: empty string" - else return $ unsafeLast c - go _ (Chunk c cs) = go c cs - go x (Go m) = m >>= go x -{-# INLINABLE last_ #-} - - -last :: Monad m => ByteString m r -> m (Of (Maybe Word8) r) -last (Empty r) = return (Nothing :> r) -last (Go m) = m >>= last -last (Chunk c0 cs0) = go c0 cs0 - where - go c (Empty r) = return $ (Just (unsafeLast c) :> r) - go _ (Chunk c cs) = go c cs - go x (Go m) = m >>= go x -{-# INLINABLE last #-} - - -isPrefixOf :: Monad m => S.ByteString -> ByteString m r -> m (Sum (ByteString m) (ByteString m) r) -isPrefixOf bytes bs = do - let len = S.length bytes - (bytes' :> rest) <- toStrict $ splitAt (fromIntegral len) bs - if bytes' == bytes - then return $ InR $ chunk bytes' >> rest - else return $ InL $ chunk bytes' >> rest --- -- | /O(n\/c)/ Return all the elements of a 'ByteString' except the last one. --- init :: ByteString -> ByteString --- init Empty = errorEmptyStream "init" --- init (Chunk c0 cs0) = go c0 cs0 --- where go c Empty | S.length c == 1 = Empty --- | otherwise = Chunk (S.unsafeInit c) Empty --- go c (Chunk c' cs) = Chunk c (go c' cs) --- --- -- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning Nothing --- -- if it is empty. --- -- --- -- * It is no faster than using 'init' and 'last' --- unsnoc :: ByteString -> Maybe (ByteString, Word8) --- unsnoc Empty = Nothing --- unsnoc (Chunk c cs) = Just (init (Chunk c cs), last (Chunk c cs)) - --- | /O(n\/c)/ Append two -append :: Monad m => ByteString m r -> ByteString m s -> ByteString m s -append xs ys = dematerialize xs (const ys) Chunk Go -{-# INLINE append #-} --- --- --------------------------------------------------------------------- --- Transformations - --- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each --- element of @xs@. -map :: Monad m => (Word8 -> Word8) -> ByteString m r -> ByteString m r -map f z = dematerialize z - Empty - (\bs x -> Chunk (S.map f bs) x) - Go --- map f s = go s --- where --- go (Empty r) = Empty r --- go (Chunk x xs) = Chunk y ys --- where --- y = S.map f x --- ys = go xs --- go (Go mbs) = Go (liftM go mbs) -{-# INLINE map #-} --- --- -- | /O(n)/ 'reverse' @xs@ returns the elements of @xs@ in reverse order. --- reverse :: ByteString -> ByteString --- reverse cs0 = rev Empty cs0 --- where rev a Empty = a --- rev a (Chunk c cs) = rev (Chunk (S.reverse c) a) cs --- {-# INLINE reverse #-} --- --- -- | The 'intersperse' function takes a 'Word8' and a 'ByteString' and --- -- \`intersperses\' that byte between the elements of the 'ByteString'. --- -- It is analogous to the intersperse function on Streams. -intersperse :: Monad m => Word8 -> ByteString m r -> ByteString m r -intersperse _ (Empty r) = Empty r -intersperse w (Go m) = Go (liftM (intersperse w) m) -intersperse w (Chunk c cs) = Chunk (S.intersperse w c) - (dematerialize cs Empty (Chunk . intersperse') Go) - where intersperse' :: P.ByteString -> P.ByteString - intersperse' (S.PS fp o l) = - S.unsafeCreate (2*l) $ \p' -> withForeignPtr fp $ \p -> do - poke p' w - S.c_intersperse (p' `plusPtr` 1) (p `plusPtr` o) (fromIntegral l) w - -{-# INLINABLE intersperse #-} - --- | 'foldr', applied to a binary operator, a starting value --- (typically the right-identity of the operator), and a ByteString, --- reduces the ByteString using the binary operator, from right to left. --- --- > foldr cons = id --- -foldr :: Monad m => (Word8 -> a -> a) -> a -> ByteString m () -> m a -foldr k = foldrChunks (flip (S.foldr k)) -{-# INLINE foldr #-} - --- -- --------------------------------------------------------------------- --- | 'fold', applied to a binary operator, a starting value (typically --- the left-identity of the operator), and a ByteString, reduces the --- ByteString using the binary operator, from left to right. --- We use the style of the foldl libarary for left folds -fold :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteString m () -> m b -fold step0 begin done p0 = loop p0 begin - where - loop p !x = case p of - Chunk bs bss -> loop bss $! S.foldl' step0 x bs - Go m -> m >>= \p' -> loop p' x - Empty _ -> return (done x) -{-# INLINABLE fold #-} - - --- | 'fold_' keeps the return value of the left-folded bytestring. Useful for --- simultaneous folds over a segmented bytestream - -fold_ :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteString m r -> m (Of b r) -fold_ step0 begin done p0 = loop p0 begin - where - loop p !x = case p of - Chunk bs bss -> loop bss $! S.foldl' step0 x bs - Go m -> m >>= \p' -> loop p' x - Empty r -> return (done x :> r) -{-# INLINABLE fold_ #-} - --- - --- -- --- -- | 'foldl1' is a variant of 'foldl' that has no starting value --- -- argument, and thus must be applied to non-empty 'ByteStrings'. --- foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 --- foldl1 _ Empty = errorEmptyStream "foldl1" --- foldl1 f (Chunk c cs) = foldl f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) --- --- -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator. --- foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 --- foldl1' _ Empty = errorEmptyStream "foldl1'" --- foldl1' f (Chunk c cs) = foldl' f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) --- --- -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, --- -- and thus must be applied to non-empty 'ByteString's --- foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 --- foldr1 _ Empty = errorEmptyStream "foldr1" --- foldr1 f (Chunk c0 cs0) = go c0 cs0 --- where go c Empty = S.foldr1 f c --- go c (Chunk c' cs) = S.foldr f (go c' cs) c --- --- --------------------------------------------------------------------- --- Special folds - --- /O(n)/ Concatenate a list of ByteStrings. --- concat :: (Monad m) => [ByteString m ()] -> ByteString m () --- concat css0 = to css0 --- where --- go css (Empty m') = to css --- go css (Chunk c cs) = Chunk c (go css cs) --- go css (Go m) = Go (liftM (go css) m) --- to [] = Empty () --- to (cs:css) = go css cs - - --- -- | Map a function over a 'ByteString' and concatenate the results --- concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString --- concatMap _ Empty = Empty --- concatMap f (Chunk c0 cs0) = to c0 cs0 --- where --- go :: ByteString -> P.ByteString -> ByteString -> ByteString --- go Empty c' cs' = to c' cs' --- go (Chunk c cs) c' cs' = Chunk c (go cs c' cs') --- --- to :: P.ByteString -> ByteString -> ByteString --- to c cs | S.null c = case cs of --- Empty -> Empty --- (Chunk c' cs') -> to c' cs' --- | otherwise = go (f (S.unsafeHead c)) (S.unsafeTail c) cs --- --- -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if --- -- any element of the 'ByteString' satisfies the predicate. --- any :: (Word8 -> Bool) -> ByteString -> Bool --- any f cs = foldrChunks (\c rest -> S.any f c || rest) False cs --- {-# INLINE any #-} --- -- todo fuse --- --- -- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines --- -- if all elements of the 'ByteString' satisfy the predicate. --- all :: (Word8 -> Bool) -> ByteString -> Bool --- all f cs = foldrChunks (\c rest -> S.all f c && rest) True cs --- {-# INLINE all #-} --- -- todo fuse --- --- -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString' --- maximum :: ByteString -> Word8 --- maximum Empty = errorEmptyStream "maximum" --- maximum (Chunk c cs) = foldlChunks (\n c' -> n `max` S.maximum c') --- (S.maximum c) cs --- {-# INLINE maximum #-} --- --- -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString' --- minimum :: ByteString -> Word8 --- minimum Empty = errorEmptyStream "minimum" --- minimum (Chunk c cs) = foldlChunks (\n c' -> n `min` S.minimum c') --- (S.minimum c) cs --- {-# INLINE minimum #-} --- --- -- | 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 --- -- final value of this accumulator together with the new ByteString. --- mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) --- mapAccumL f s0 cs0 = go s0 cs0 --- where --- go s Empty = (s, Empty) --- go s (Chunk c cs) = (s'', Chunk c' cs') --- where (s', c') = S.mapAccumL f s c --- (s'', cs') = go s' cs --- --- -- | The 'mapAccumR' function behaves like a combination of 'map' and --- -- 'foldr'; it applies a function to each element of a ByteString, --- -- passing an accumulating parameter from right to left, and returning a --- -- final value of this accumulator together with the new ByteString. --- mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) --- mapAccumR f s0 cs0 = go s0 cs0 --- where --- go s Empty = (s, Empty) --- go s (Chunk c cs) = (s'', Chunk c' cs') --- where (s'', c') = S.mapAccumR f s' c --- (s', cs') = go s cs --- --- -- --------------------------------------------------------------------- --- -- Building ByteStrings --- --- -- | 'scanl' is similar to 'foldl', but returns a list of successive --- -- reduced values from the left. This function will fuse. --- -- --- -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] --- -- --- -- Note that --- -- --- -- > last (scanl f z xs) == foldl f z xs. --- scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString --- scanl f z = snd . foldl k (z,singleton z) --- where --- k (c,acc) a = let n = f c a in (n, acc `snoc` n) --- {-# INLINE scanl #-} --- --- --------------------------------------------------------------------- --- Unfolds and replicates - -{-| @'iterate' f x@ returns an infinite ByteString of repeated applications --- of @f@ to @x@: - -> iterate f x == [x, f x, f (f x), ...] - ->>> R.stdout $ R.take 50 $ R.iterate succ 39 -()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY ->>> Q.putStrLn $ Q.take 50 $ Q.iterate succ '\'' -()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY - --} -iterate :: (Word8 -> Word8) -> Word8 -> ByteString m r -iterate f = unfoldr (\x -> case f x of !x' -> Right (x', x')) -{-# INLINABLE iterate #-} - -{- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every - element. - ->>> R.stdout $ R.take 50 $ R.repeat 60 -<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ->>> Q.putStrLn $ Q.take 50 $ Q.repeat 'z' -zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz --} -repeat :: Word8 -> ByteString m r -repeat w = cs where cs = Chunk (S.replicate BI.smallChunkSize w) cs -{-# INLINABLE repeat #-} - --- -- | /O(n)/ @'replicate' n x@ is a ByteString of length @n@ with @x@ --- -- the value of every element. --- -- --- replicate :: Int64 -> Word8 -> ByteString --- replicate n w --- | n <= 0 = Empty --- | n < fromIntegral smallChunkSize = Chunk (S.replicate (fromIntegral n) w) Empty --- | r == 0 = cs -- preserve invariant --- | otherwise = Chunk (S.unsafeTake (fromIntegral r) c) cs --- where --- c = S.replicate smallChunkSize w --- cs = nChunks q --- (q, r) = quotRem n (fromIntegral smallChunkSize) --- nChunks 0 = Empty --- nChunks m = Chunk c (nChunks (m-1)) - -{- | 'cycle' ties a finite ByteString into a circular one, or equivalently, - the infinite repetition of the original ByteString. For an empty bytestring - (like @return 17@) it of course makes an unproductive loop - ->>> Q.putStrLn $ Q.take 7 $ Q.cycle "y\n" -y -y -y -y --} -cycle :: Monad m => ByteString m r -> ByteString m s -cycle = forever -{-# INLINE cycle #-} - --- | /O(n)/ The 'unfoldr' function is analogous to the Stream @unfoldr@. --- 'unfoldr' builds a ByteString from a seed value. The function takes --- the element and returns 'Nothing' if it is done producing the --- ByteString or returns @'Just' (a,b)@, in which case, @a@ is a --- prepending to the ByteString and @b@ is used as the next element in a --- recursive call. - -unfoldM :: Monad m => (a -> Maybe (Word8, a)) -> a -> ByteString m () -unfoldM f s0 = unfoldChunk 32 s0 - where unfoldChunk n s = - case S.unfoldrN n f s of - (c, Nothing) - | S.null c -> Empty () - | otherwise -> Chunk c (Empty ()) - (c, Just s') -> Chunk c (unfoldChunk (n*2) s') -{-# INLINABLE unfoldM #-} - --- | 'unfold' is like 'unfoldr' but stops when the co-algebra --- returns 'Left'; the result is the return value of the @ByteString m r@ --- @unfoldr uncons = id@ -unfoldr :: (a -> Either r (Word8, a)) -> a -> ByteString m r -unfoldr f s0 = unfoldChunk 32 s0 - where unfoldChunk n s = - case unfoldrNE n f s of - (c, Left r) - | S.null c -> Empty r - | otherwise -> Chunk c (Empty r) - (c, Right s') -> Chunk c (unfoldChunk (n*2) s') -{-# INLINABLE unfoldr #-} - --- --------------------------------------------------------------------- --- Substrings - -{-| /O(n\/c)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix - of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. - - Note that in the streaming context this drops the final return value; - 'splitAt' preserves this information, and is sometimes to be preferred. - ->>> Q.putStrLn $ Q.take 8 $ "Is there a God?" >> return True -Is there ->>> Q.putStrLn $ "Is there a God?" >> return True -Is there a God? -True ->>> rest <- Q.putStrLn $ Q.splitAt 8 $ "Is there a God?" >> return True -Is there ->>> Q.effects rest -True - --} -take :: Monad m => Int64 -> ByteString m r -> ByteString m () -take i _ | i <= 0 = Empty () -take i cs0 = take' i cs0 - where take' 0 _ = Empty () - take' _ (Empty _) = Empty () - take' n (Chunk c cs) = - if n < fromIntegral (S.length c) - then Chunk (S.take (fromIntegral n) c) (Empty ()) - else Chunk c (take' (n - fromIntegral (S.length c)) cs) - take' n (Go m) = Go (liftM (take' n) m) -{-# INLINABLE take #-} - -{-| /O(n\/c)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ - elements, or @[]@ if @n > 'length' xs@. - ->>> Q.putStrLn $ Q.drop 6 "Wisconsin" -sin ->>> Q.putStrLn $ Q.drop 16 "Wisconsin" - ->>> --} -drop :: Monad m => Int64 -> ByteString m r -> ByteString m r -drop i p | i <= 0 = p -drop i cs0 = drop' i cs0 - where drop' 0 cs = cs - drop' _ (Empty r) = Empty r - drop' n (Chunk c cs) = - if n < fromIntegral (S.length c) - then Chunk (S.drop (fromIntegral n) c) cs - else drop' (n - fromIntegral (S.length c)) cs - drop' n (Go m) = Go (liftM (drop' n) m) -{-# INLINABLE drop #-} - - -{-| /O(n\/c)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. - ->>> rest <- Q.putStrLn $ Q.splitAt 3 "therapist is a danger to good hyphenation, as Knuth notes" -the ->>> Q.putStrLn $ Q.splitAt 19 rest -rapist is a danger - --} -splitAt :: Monad m => Int64 -> ByteString m r -> ByteString m (ByteString m r) -splitAt i cs0 | i <= 0 = Empty cs0 -splitAt i cs0 = splitAt' i cs0 - where splitAt' 0 cs = Empty cs - splitAt' _ (Empty r ) = Empty (Empty r) - splitAt' n (Chunk c cs) = - if n < fromIntegral (S.length c) - then Chunk (S.take (fromIntegral n) c) $ - Empty (Chunk (S.drop (fromIntegral n) c) cs) - else Chunk c (splitAt' (n - fromIntegral (S.length c)) cs) - splitAt' n (Go m) = Go (liftM (splitAt' n) m) -{-# INLINABLE splitAt #-} - --- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, --- returns the longest prefix (possibly empty) of @xs@ of elements that --- satisfy @p@. -takeWhile :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m () -takeWhile f cs0 = takeWhile' cs0 - where - takeWhile' (Empty _) = Empty () - takeWhile' (Go m) = Go $ liftM takeWhile' m - takeWhile' (Chunk c cs) = - case findIndexOrEnd (not . f) c of - 0 -> Empty () - n | n < S.length c -> Chunk (S.take n c) (Empty ()) - | otherwise -> Chunk c (takeWhile' cs) -{-# INLINABLE takeWhile #-} - --- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. -dropWhile :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m r -dropWhile pred = drop' where - drop' bs = case bs of - Empty r -> Empty r - Go m -> Go (liftM drop' m) - Chunk c cs -> case findIndexOrEnd (not.pred) c of - 0 -> Chunk c cs - n | n < S.length c -> Chunk (S.drop n c) cs - | otherwise -> drop' cs -{-#INLINABLE dropWhile #-} - --- | 'break' @p@ is equivalent to @'span' ('not' . p)@. -break :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m (ByteString m r) -break f cs0 = break' cs0 - where break' (Empty r) = Empty (Empty r) - break' (Chunk c cs) = - case findIndexOrEnd f c of - 0 -> Empty (Chunk c cs) - n | n < S.length c -> Chunk (S.take n c) $ - Empty (Chunk (S.drop n c) cs) - | otherwise -> Chunk c (break' cs) - break' (Go m) = Go (liftM break' m) -{-# INLINABLE break #-} - --- --- -- TODO --- -- --- -- Add rules --- -- --- --- {- --- -- | 'breakByte' breaks its ByteString argument at the first occurence --- -- of the specified byte. It is more efficient than 'break' as it is --- -- implemented with @memchr(3)@. I.e. --- -- --- -- > break (=='c') "abcd" == breakByte 'c' "abcd" --- -- --- breakByte :: Word8 -> ByteString -> (ByteString, ByteString) --- breakByte c (LPS ps) = case (breakByte' ps) of (a,b) -> (LPS a, LPS b) --- where breakByte' [] = ([], []) --- breakByte' (x:xs) = --- case P.elemIndex c x of --- Just 0 -> ([], x : xs) --- Just n -> (P.take n x : [], P.drop n x : xs) --- Nothing -> let (xs', xs'') = breakByte' xs --- in (x : xs', xs'') --- --- -- | 'spanByte' breaks its ByteString argument at the first --- -- occurence of a byte other than its argument. It is more efficient --- -- than 'span (==)' --- -- --- -- > span (=='c') "abcd" == spanByte 'c' "abcd" --- -- --- spanByte :: Word8 -> ByteString -> (ByteString, ByteString) --- spanByte c (LPS ps) = case (spanByte' ps) of (a,b) -> (LPS a, LPS b) --- where spanByte' [] = ([], []) --- spanByte' (x:xs) = --- case P.spanByte c x of --- (x', x'') | P.null x' -> ([], x : xs) --- | P.null x'' -> let (xs', xs'') = spanByte' xs --- in (x : xs', xs'') --- | otherwise -> (x' : [], x'' : xs) --- -} --- --- | 'span' @p xs@ breaks the ByteString into two segments. It is --- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ -span :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m (ByteString m r) -span p = break (not . p) -{-# INLINE span #-} - --- | /O(n)/ Splits a 'ByteString' into components delimited by --- separators, where the predicate returns True for a separator element. --- The resulting components do not contain the separators. Two adjacent --- separators result in an empty component in the output. eg. --- --- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] --- > splitWith (=='a') [] == [] --- -splitWith :: Monad m => (Word8 -> Bool) -> ByteString m r -> Stream (ByteString m) m r -splitWith _ (Empty r) = Return r -splitWith p (Go m) = Effect $ liftM (splitWith p) m -splitWith p (Chunk c0 cs0) = comb [] (S.splitWith p c0) cs0 - where --- comb :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString] --- comb acc (s:[]) (Empty r) = Step (revChunks (s:acc) (Return r)) - comb acc [s] (Empty r) = Step $ L.foldl' (flip Chunk) - (Empty (Return r)) - (s:acc) - comb acc [s] (Chunk c cs) = comb (s:acc) (S.splitWith p c) cs - comb acc b (Go m) = Effect (liftM (comb acc b) m) - comb acc (s:ss) cs = Step $ L.foldl' (flip Chunk) - (Empty (comb [] ss cs)) - (s:acc) - comb acc [] (Empty r) = Step $ L.foldl' (flip Chunk) - (Empty (Return r)) - acc - comb acc [] (Chunk c cs) = comb acc (S.splitWith p c) cs - -- comb acc (s:ss) cs = Step (revChunks (s:acc) (comb [] ss cs)) - -{-# INLINABLE splitWith #-} - --- | /O(n)/ Break a 'ByteString' 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 'ByteStrings' that --- are slices of the original. --- -split :: Monad m => Word8 -> ByteString m r -> Stream (ByteString m) m r -split w = loop - where - loop !x = case x of - Empty r -> Return r - Go m -> Effect $ liftM loop m - Chunk c0 cs0 -> comb [] (S.split w c0) cs0 - comb !acc [] (Empty r) = Step $ revChunks acc (Return r) - comb acc [] (Chunk c cs) = comb acc (S.split w c) cs - comb !acc (s:[]) (Empty r) = Step $ revChunks (s:acc) (Return r) - comb acc (s:[]) (Chunk c cs) = comb (s:acc) (S.split w c) cs - comb acc b (Go m) = Effect (liftM (comb acc b) m) - comb acc (s:ss) cs = Step $ revChunks (s:acc) (comb [] ss cs) -{-# INLINABLE split #-} - - --- --- | The 'group' function takes a ByteString and returns a list of --- ByteStrings such that the concatenation of the result is equal to the --- argument. Moreover, each sublist in the result contains only equal --- elements. For example, --- --- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] --- --- It is a special case of 'groupBy', which allows the programmer to --- supply their own equality test. - -group :: Monad m => ByteString m r -> Stream (ByteString m) m r -group = go - where - go (Empty r) = Return r - go (Go m) = Effect $ liftM go m - go (Chunk c cs) - | S.length c == 1 = Step $ to [c] (S.unsafeHead c) cs - | otherwise = Step $ to [S.unsafeTake 1 c] (S.unsafeHead c) - (Chunk (S.unsafeTail c) cs) - - to acc !_ (Empty r) = revNonEmptyChunks - acc - (Empty (Return r)) - to acc !w (Chunk c cs) = - case findIndexOrEnd (/= w) c of - 0 -> revNonEmptyChunks - acc - (Empty (go (Chunk c cs))) - n | n == S.length c -> to (S.unsafeTake n c : acc) w cs - | otherwise -> revNonEmptyChunks - (S.unsafeTake n c : acc) - (Empty (go (Chunk (S.unsafeDrop n c) cs))) - -{-#INLINABLE group #-} - --- | The 'groupBy' function is a generalized version of 'group'. -groupBy :: Monad m => (Word8 -> Word8 -> Bool) -> ByteString m r -> Stream (ByteString m) m r -groupBy rel = go - where - go (Empty r) = Return r - go (Go m) = Effect $ liftM go m - go (Chunk c cs) - | S.length c == 1 = Step $ to [c] (S.unsafeHead c) cs - | otherwise = Step $ to [S.unsafeTake 1 c] (S.unsafeHead c) - (Chunk (S.unsafeTail c) cs) - - to acc !_ (Empty r) = revNonEmptyChunks - acc - (Empty (Return r)) - to acc !w (Chunk c cs) = - case findIndexOrEnd (not . rel w) c of - 0 -> revNonEmptyChunks - acc - (Empty (go (Chunk c cs))) - n | n == S.length c -> to (S.unsafeTake n c : acc) w cs - | otherwise -> revNonEmptyChunks - (S.unsafeTake n c : acc) - (Empty (go (Chunk (S.unsafeDrop n c) cs))) -{-#INLINABLE groupBy #-} - --- -- | The 'groupBy' function is the non-overloaded version of 'group'. --- -- --- groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] --- groupBy k = go --- where --- go Empty = [] --- go (Chunk c cs) --- | S.length c == 1 = to [c] (S.unsafeHead c) cs --- | otherwise = to [S.unsafeTake 1 c] (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) --- --- to acc !_ Empty = revNonEmptyChunks acc : [] --- to acc !w (Chunk c cs) = --- case findIndexOrEnd (not . k w) c of --- 0 -> revNonEmptyChunks acc --- : go (Chunk c cs) --- n | n == S.length c -> to (S.unsafeTake n c : acc) w cs --- | otherwise -> revNonEmptyChunks (S.unsafeTake n c : acc) --- : go (Chunk (S.unsafeDrop n c) cs) --- --- | /O(n)/ The 'intercalate' function takes a 'ByteString' and a list of --- 'ByteString's and concatenates the list after interspersing the first --- argument between each element of the list. -intercalate :: Monad m => ByteString m () -> Stream (ByteString m) m r -> ByteString m r -intercalate _ (Return r) = Empty r -intercalate s (Effect m) = Go $ liftM (intercalate s) m -intercalate s (Step bs0) = do -- this isn't quite right - ls <- bs0 - s - intercalate s ls - -- where - -- loop (Return r) = Empty r -- concat . (L.intersperse s) - -- loop (Effect m) = Go $ liftM loop m - -- loop (Step bs) = do - -- ls <- bs - -- case ls of - -- Return r -> Empty r -- no '\n' before end, in this case. - -- x -> s >> loop x -{-# INLINABLE intercalate #-} - - --- | count returns the number of times its argument appears in the ByteString --- --- > count = length . elemIndices --- -count_ :: Monad m => Word8 -> ByteString m r -> m Int -count_ w = liftM (\(n :> _) -> n) . foldlChunks (\n c -> n + fromIntegral (S.count w c)) 0 -{-# INLINE count_ #-} - --- But more efficiently than using length on the intermediate list. -count :: Monad m => Word8 -> ByteString m r -> m (Of Int r) -count w cs = foldlChunks (\n c -> n + fromIntegral (S.count w c)) 0 cs -{-# INLINE count #-} - --- -- | The 'findIndex' function takes a predicate and a 'ByteString' and --- -- returns the index of the first element in the ByteString --- -- satisfying the predicate. --- findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int64 --- findIndex k cs0 = findIndex' 0 cs0 --- where findIndex' _ Empty = Nothing --- findIndex' n (Chunk c cs) = --- case S.findIndex k c of --- Nothing -> findIndex' (n + fromIntegral (S.length c)) cs --- Just i -> Just (n + fromIntegral i) --- {-# INLINE findIndex #-} --- --- -- | /O(n)/ The 'find' function takes a predicate and a ByteString, --- -- and returns the first element in matching the predicate, or 'Nothing' --- -- if there is no such element. --- -- --- -- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing --- -- --- find :: (Word8 -> Bool) -> ByteString -> Maybe Word8 --- find f cs0 = find' cs0 --- where find' Empty = Nothing --- find' (Chunk c cs) = case S.find f c of --- Nothing -> find' cs --- Just w -> Just w --- {-# INLINE find #-} --- --- -- | The 'findIndices' function extends 'findIndex', by returning the --- -- indices of all elements satisfying the predicate, in ascending order. --- findIndices :: (Word8 -> Bool) -> ByteString -> [Int64] --- findIndices k cs0 = findIndices' 0 cs0 --- where findIndices' _ Empty = [] --- findIndices' n (Chunk c cs) = L.map ((+n).fromIntegral) (S.findIndices k c) --- ++ findIndices' (n + fromIntegral (S.length c)) cs --- --- --------------------------------------------------------------------- --- Searching ByteStrings - --- | /O(n)/ 'filter', applied to a predicate and a ByteString, --- returns a ByteString containing those characters that satisfy the --- predicate. -filter :: Monad m => (Word8 -> Bool) -> ByteString m r -> ByteString m r -filter p s = go s - where - go (Empty r ) = Empty r - go (Chunk x xs) = consChunk (S.filter p x) (go xs) - go (Go m) = Go (liftM go m) - -- should inspect for null -{-# INLINABLE filter #-} - --- {- --- -- | /O(n)/ and /O(n\/c) space/ A first order equivalent of /filter . --- -- (==)/, for the common case of filtering a single byte. It is more --- -- efficient to use /filterByte/ in this case. --- -- --- -- > filterByte == filter . (==) --- -- --- -- filterByte is around 10x faster, and uses much less space, than its --- -- filter equivalent --- filterByte :: Word8 -> ByteString -> ByteString --- filterByte w ps = replicate (count w ps) w --- {-# INLINE filterByte #-} --- --- {-# RULES --- "ByteString specialise filter (== x)" forall x. --- filter ((==) x) = filterByte x --- --- "ByteString specialise filter (== x)" forall x. --- filter (== x) = filterByte x --- #-} --- -} --- --- {- --- -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common --- -- case of filtering a single byte out of a list. It is more efficient --- -- to use /filterNotByte/ in this case. --- -- --- -- > filterNotByte == filter . (/=) --- -- --- -- filterNotByte is around 2x faster than its filter equivalent. --- filterNotByte :: Word8 -> ByteString -> ByteString --- filterNotByte w (LPS xs) = LPS (filterMap (P.filterNotByte w) xs) --- -} - - --- -- --------------------------------------------------------------------- --- -- Zipping --- --- -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of --- -- corresponding pairs of bytes. If one input ByteString is short, --- -- excess elements of the longer ByteString are discarded. This is --- -- equivalent to a pair of 'unpack' operations. --- zip :: ByteString -> ByteString -> [(Word8,Word8)] --- zip = zipWith (,) --- --- -- | 'zipWith' generalises 'zip' by zipping with the function given as --- -- the first argument, instead of a tupling function. For example, --- -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of --- -- corresponding sums. --- zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a] --- zipWith _ Empty _ = [] --- zipWith _ _ Empty = [] --- zipWith f (Chunk a as) (Chunk b bs) = go a as b bs --- where --- go x xs y ys = f (S.unsafeHead x) (S.unsafeHead y) --- : to (S.unsafeTail x) xs (S.unsafeTail y) ys --- --- to x Empty _ _ | S.null x = [] --- to _ _ y Empty | S.null y = [] --- to x xs y ys | not (S.null x) --- && not (S.null y) = go x xs y ys --- to x xs _ (Chunk y' ys) | not (S.null x) = go x xs y' ys --- to _ (Chunk x' xs) y ys | not (S.null y) = go x' xs y ys --- to _ (Chunk x' xs) _ (Chunk y' ys) = go x' xs y' ys --- --- -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of --- -- ByteStrings. Note that this performs two 'pack' operations. --- unzip :: [(Word8,Word8)] -> (ByteString,ByteString) --- unzip ls = (pack (L.map fst ls), pack (L.map snd ls)) --- {-# INLINE unzip #-} --- - --- --------------------------------------------------------------------- --- ByteString IO --- --- Rule for when to close: is it expected to read the whole file? --- If so, close when done. --- - -{- | Read entire handle contents /lazily/ into a 'ByteString'. Chunks - are read on demand, in at most @k@-sized chunks. It does not block - waiting for a whole @k@-sized chunk, so if less than @k@ bytes are - available then they will be returned immediately as a smaller chunk. - - The handle is closed on EOF. - - Note: the 'Handle' should be placed in binary mode with - 'System.IO.hSetBinaryMode' for 'hGetContentsN' to - work correctly. --} -hGetContentsN :: MonadIO m => Int -> Handle -> ByteString m () -hGetContentsN k h = loop -- TODO close on exceptions - where --- lazyRead = unsafeInterleaveIO loop - loop = do - c <- liftIO (S.hGetSome h k) - -- only blocks if there is no data available - if S.null c - then Empty () - else Chunk c loop -{-#INLINABLE hGetContentsN #-} -- very effective inline pragma - --- | Read @n@ bytes into a 'ByteString', directly from the --- specified 'Handle', in chunks of size @k@. --- -hGetN :: MonadIO m => Int -> Handle -> Int -> ByteString m () -hGetN k h n | n > 0 = readChunks n - where - readChunks !i = Go $ do - c <- liftIO $ S.hGet h (min k i) - case S.length c of - 0 -> return $ Empty () - m -> return $ Chunk c (readChunks (i - m)) - -hGetN _ _ 0 = Empty () -hGetN _ h n = liftIO $ illegalBufferSize h "hGet" n -- <--- REPAIR !!! -{-#INLINABLE hGetN #-} - --- | hGetNonBlockingN is similar to 'hGetContentsN', except that it will never block --- waiting for data to become available, instead it returns only whatever data --- is available. Chunks are read on demand, in @k@-sized chunks. - -hGetNonBlockingN :: MonadIO m => Int -> Handle -> Int -> ByteString m () -hGetNonBlockingN k h n | n > 0 = readChunks n - where - readChunks !i = Go $ do - c <- liftIO $ S.hGetNonBlocking h (min k i) - case S.length c of - 0 -> return (Empty ()) - m -> return (Chunk c (readChunks (i - m))) -hGetNonBlockingN _ _ 0 = Empty () -hGetNonBlockingN _ h n = liftIO $ illegalBufferSize h "hGetNonBlocking" n -{-# INLINABLE hGetNonBlockingN #-} - - -illegalBufferSize :: Handle -> String -> Int -> IO a -illegalBufferSize handle fn sz = - ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing) - --TODO: System.IO uses InvalidArgument here, but it's not exported :-( - where - msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz [] -{-# INLINABLE illegalBufferSize #-} - -{-| Read entire handle contents /lazily/ into a 'ByteString'. Chunks - are read on demand, using the default chunk size. - - Once EOF is encountered, the Handle is closed. - - Note: the 'Handle' should be placed in binary mode with - 'System.IO.hSetBinaryMode' for 'hGetContents' to - work correctly. --} -hGetContents :: MonadIO m => Handle -> ByteString m () -hGetContents = hGetContentsN defaultChunkSize -{-#INLINE hGetContents #-} - --- | Pipes-style nomenclature for 'hGetContents' -fromHandle :: MonadIO m => Handle -> ByteString m () -fromHandle = hGetContents -{-#INLINE fromHandle #-} - --- | Pipes-style nomenclature for 'getContents' -stdin :: MonadIO m => ByteString m () -stdin = hGetContents IO.stdin -{-#INLINE stdin #-} - --- | Read @n@ bytes into a 'ByteString', directly from the specified 'Handle'. --- -hGet :: MonadIO m => Handle -> Int -> ByteString m () -hGet = hGetN defaultChunkSize -{-#INLINE hGet #-} - --- | hGetNonBlocking is similar to 'hGet', except that it will never block --- waiting for data to become available, instead it returns only whatever data --- is available. If there is no data available to be read, 'hGetNonBlocking' --- returns 'empty'. --- --- Note: on Windows and with Haskell implementation other than GHC, this --- function does not work correctly; it behaves identically to 'hGet'. --- -hGetNonBlocking :: MonadIO m => Handle -> Int -> ByteString m () -hGetNonBlocking = hGetNonBlockingN defaultChunkSize -{-#INLINE hGetNonBlocking #-} - -{-| Write a 'ByteString' to a file. Use 'Control.Monad.Trans.ResourceT.runResourceT' - to ensure that the handle is closed. - ->>> :set -XOverloadedStrings ->>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" ->>> :! cat "hello.txt" -Hello world. -Goodbye world. ->>> runResourceT $ Q.writeFile "hello2.txt" $ Q.readFile "hello.txt" ->>> :! cat hello2.txt -Hello world. -Goodbye world. - - -} -writeFile :: MonadResource m => FilePath -> ByteString m r -> m r -writeFile f str = do - (key, handle) <- allocate (openBinaryFile f WriteMode) hClose - r <- hPut handle str - release key - return r -{-# INLINE writeFile #-} - -{-| Read an entire file into a chunked @'ByteString' IO ()@. - The handle will be held open until EOF is encountered. - The block governed by 'Control.Monad.Trans.Resource.runResourceT' - will end with the closing of any handles opened. - ->>> :! cat hello.txt -Hello world. -Goodbye world. ->>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" -Hello world. -Goodbye world. - -} - -readFile :: MonadResource m => FilePath -> ByteString m () -readFile f = bracketByteString (openBinaryFile f ReadMode) hClose hGetContents -{-#INLINE readFile #-} - - - -{-| Append a 'ByteString' to a file. Use 'Control.Monad.Trans.ResourceT.runResourceT' - to ensure that the handle is closed. - ->>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" ->>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" -Hello world. -Goodbye world. ->>> runResourceT $ Q.appendFile "hello.txt" "sincerely yours,\nArthur\n" ->>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" -Hello world. -Goodbye world. -sincerely yours, -Arthur - -} -appendFile :: MonadResource m => FilePath -> ByteString m r -> m r -appendFile f str = do - (key, handle) <- allocate (openBinaryFile f AppendMode) hClose - r <- hPut handle str - release key - return r -{-# INLINE appendFile #-} - --- | getContents. Equivalent to hGetContents stdin. Will read /lazily/ --- -getContents :: MonadIO m => ByteString m () -getContents = hGetContents IO.stdin -{-# INLINE getContents #-} - --- | Outputs a 'ByteString' to the specified 'Handle'. --- -hPut :: MonadIO m => Handle -> ByteString m r -> m r -hPut h cs = dematerialize cs return (\x y -> liftIO (S.hPut h x) >> y) (>>= id) -{-#INLINE hPut #-} - --- | Pipes nomenclature for 'hPut' -toHandle :: MonadIO m => Handle -> ByteString m r -> m r -toHandle = hPut -{-#INLINE toHandle #-} - --- | Pipes-style nomenclature for 'putStr' -stdout :: MonadIO m => ByteString m r -> m r -stdout = hPut IO.stdout -{-#INLINE stdout#-} - --- -- | Similar to 'hPut' except that it will never block. Instead it returns --- any tail that did not get written. This tail may be 'empty' in the case that --- the whole string was written, or the whole original string if nothing was --- written. Partial writes are also possible. --- --- Note: on Windows and with Haskell implementation other than GHC, this --- function does not work correctly; it behaves identically to 'hPut'. --- --- hPutNonBlocking :: MonadIO m => Handle -> ByteString m r -> ByteString m r --- hPutNonBlocking _ (Empty r) = Empty r --- hPutNonBlocking h (Go m) = Go $ liftM (hPutNonBlocking h) m --- hPutNonBlocking h bs@(Chunk c cs) = do --- c' <- lift $ S.hPutNonBlocking h c --- case S.length c' of --- l' | l' == S.length c -> hPutNonBlocking h cs --- 0 -> bs --- _ -> Chunk c' cs --- {-# INLINABLE hPutNonBlocking #-} - --- | A synonym for @hPut@, for compatibility --- --- hPutStr :: Handle -> ByteString IO r -> IO r --- hPutStr = hPut --- --- -- | Write a ByteString to stdout --- putStr :: ByteString IO r -> IO r --- putStr = hPut IO.stdout - --- -- | Write a ByteString to stdout, appending a newline byte --- -- --- putStrLn :: ByteString -> IO () --- putStrLn ps = hPut stdout ps >> hPut stdout (singleton 0x0a) --- - - -{- | The interact function takes a function of type @ByteString -> ByteString@ - as its argument. The entire input from the standard input device is passed - to this function as its argument, and the resulting string is output on the - standard output device. - -> interact morph = stdout (morph stdin) --} -interact :: (ByteString IO () -> ByteString IO r) -> IO r -interact f = stdout (f stdin) -{-# INLINE interact #-} - --- -- --------------------------------------------------------------------- --- -- Internal utilities --- --- -- Common up near identical calls to `error' to reduce the number --- -- constant strings created when compiled: --- errorEmptyStream :: String -> a --- errorEmptyStream fun = moduleError fun "empty ByteString" --- {-# NOINLINE errorEmptyStream #-} --- --- moduleError :: String -> String -> a --- moduleError fun msg = error ("Data.ByteString.Lazy." ++ fun ++ ':':' ':msg) --- {-# NOINLINE moduleError #-} - -revNonEmptyChunks :: [P.ByteString] -> ByteString m r -> ByteString m r -revNonEmptyChunks = Prelude.foldr (\bs f -> Chunk bs . f) id -{-#INLINE revNonEmptyChunks#-} - -- loop p xs - -- where - -- loop !bss [] = bss - -- loop bss (b:bs) = loop (Chunk b bss) bs - -- loop' [] = id - -- loop' (b:bs) = loop' bs . Chunk b --- L.foldl' (flip Chunk) Empty cs --- foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b - --- reverse a list of possibly-empty chunks into a lazy ByteString -revChunks :: Monad m => [P.ByteString] -> r -> ByteString m r -revChunks cs r = L.foldl' (flip Chunk) (Empty r) cs -{-#INLINE revChunks #-} --- | 'findIndexOrEnd' is a variant of findIndex, that returns the length --- of the string if no element is found, rather than Nothing. -findIndexOrEnd :: (Word8 -> Bool) -> P.ByteString -> Int -findIndexOrEnd k (S.PS x s l) = - inlinePerformIO $ - withForeignPtr x $ \f -> go (f `plusPtr` s) 0 - where - go !ptr !n | n >= l = return l - | otherwise = do w <- peek ptr - if k w - then return n - else go (ptr `plusPtr` 1) (n+1) -{-# INLINABLE findIndexOrEnd #-} - -zipWithStream - :: (Monad m) - => (forall x . a -> ByteString m x -> ByteString m x) - -> [a] - -> Stream (ByteString m) m r - -> Stream (ByteString m) m r -zipWithStream op zs = loop zs - where - loop [] !ls = loop zs ls - loop a@(x:xs) ls = case ls of - Return r -> Return r - Step fls -> Step $ fmap (loop xs) (op x fls) - Effect mls -> Effect $ liftM (loop a) mls - -{-#INLINABLE zipWithStream #-} - -{- Take a builder constructed otherwise and convert it to a genuine - streaming bytestring. - ->>> Q.putStrLn $ Q.toStreamingByteString $ stringUtf8 "哈斯克尔" <> stringUtf8 " " <> integerDec 98 -哈斯克尔 98 - - shows its - indistinguishable performance is indistinguishable from @toLazyByteString@ - - --} - -toStreamingByteString - :: MonadIO m => Builder -> ByteString m () -toStreamingByteString = toStreamingByteStringWith - (safeStrategy BI.smallChunkSize BI.defaultChunkSize) -{-#INLINE toStreamingByteString #-} - -{-| Take a builder and convert it to a genuine - streaming bytestring, using a specific allocation strategy. --} -toStreamingByteStringWith - :: MonadIO m => - AllocationStrategy -> Builder -> ByteString m () -toStreamingByteStringWith strategy builder0 = do - cios <- liftIO (buildStepToCIOS strategy (runBuilder builder0)) - let loop cios0 = case cios0 of - Yield1 bs io -> Chunk bs $ do - cios1 <- liftIO io - loop cios1 - Finished buf r -> trimmedChunkFromBuffer buf (Empty r) - trimmedChunkFromBuffer buffer k - | S.null bs = k - | 2 * S.length bs < bufferSize buffer = Chunk (S.copy bs) k - | otherwise = Chunk bs k - where - bs = byteStringFromBuffer buffer - loop cios -{-#INLINABLE toStreamingByteStringWith #-} -{-#SPECIALIZE toStreamingByteStringWith :: AllocationStrategy -> Builder -> ByteString IO () #-} - - -{- Concatenate a stream of builders (not a streaming bytestring!) into a single builder. - ->>> let aa = yield (integerDec 10000) >> yield (string8 " is a number.") >> yield (char8 '\n') ->>> hPutBuilder IO.stdout $ concatBuilders aa -10000 is a number. - --} -concatBuilders :: Stream (Of Builder) IO () -> Builder -concatBuilders p = builder $ \bstep r -> do - case p of - Return _ -> runBuilderWith mempty bstep r - Step (b :> rest) -> runBuilderWith (b `mappend` concatBuilders rest) bstep r - Effect m -> m >>= \p' -> runBuilderWith (concatBuilders p') bstep r -{-#INLINABLE concatBuilders #-} - - -{-| A simple construction of a builder from a 'ByteString'. - ->>> let aaa = "10000 is a number\n" :: Q.ByteString IO () ->>> hPutBuilder IO.stdout $ toBuilder aaa -10000 is a number - - --} -toBuilder :: ByteString IO () -> Builder -toBuilder = concatBuilders . SP.map byteString . toChunks -{-#INLINABLE toBuilder #-} diff --git a/Data/ByteString/Streaming/Char8.hs b/Data/ByteString/Streaming/Char8.hs deleted file mode 100644 --- a/Data/ByteString/Streaming/Char8.hs +++ /dev/null @@ -1,728 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns #-} -{-#LANGUAGE RankNTypes, OverloadedStrings, ScopedTypeVariables #-} --- | 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 @Data.ByteString.Streaming@ and the examples of --- of use to implement simple shell operations . Examples of use --- with @http-client@, @attoparsec@, @aeson@, @zlib@ etc. can be found in the --- 'streaming-utils' library. - - -module Data.ByteString.Streaming.Char8 ( - -- * The @ByteString@ type - ByteString - - -- * Introducing and eliminating 'ByteString's - , empty -- empty :: ByteString m () - , pack -- pack :: Monad m => String -> ByteString m () - , unpack - , string - , unlines - , unwords - , singleton -- singleton :: Monad m => Char -> ByteString m () - , fromChunks -- fromChunks :: Monad m => Stream (Of ByteString) m r -> ByteString m r - , fromLazy -- fromLazy :: Monad m => ByteString -> ByteString m () - , fromStrict -- fromStrict :: ByteString -> ByteString m () - , toChunks -- toChunks :: Monad m => ByteString m r -> Stream (Of ByteString) m r - , toLazy -- toLazy :: Monad m => ByteString m () -> m ByteString - , toLazy_ - , toStrict -- toStrict :: Monad m => ByteString m () -> m ByteString - , toStrict_ - , effects - , copy - , drained - , mwrap - - - -- * Transforming ByteStrings - , map -- map :: Monad m => (Char -> Char) -> ByteString m r -> ByteString m r - , intercalate -- intercalate :: Monad m => ByteString m () -> Stream (ByteString m) m r -> ByteString m r - , intersperse -- intersperse :: Monad m => Char -> ByteString m r -> ByteString m r - - -- * Basic interface - , cons -- cons :: Monad m => Char -> ByteString m r -> ByteString m r - , cons' -- cons' :: Char -> ByteString m r -> ByteString m r - , snoc - , append -- append :: Monad m => ByteString m r -> ByteString m s -> ByteString m s - , filter -- filter :: (Char -> Bool) -> ByteString m r -> ByteString m r - , head -- head :: Monad m => ByteString m r -> m Char - , head_ -- head' :: Monad m => ByteString m r -> m (Of Char r) - , last -- last :: Monad m => ByteString m r -> m Char - , last_ -- last' :: Monad m => ByteString m r -> m (Of Char r) - , null -- null :: Monad m => ByteString m r -> m Bool - , null_ - , testNull - , nulls -- null' :: Monad m => ByteString m r -> m (Of Bool r) - , uncons -- uncons :: Monad m => ByteString m r -> m (Either r (Char, ByteString m r)) - , nextChar - - -- * Substrings - - -- ** Breaking strings - , break -- break :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m (ByteString m r) - , drop -- drop :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m r - , dropWhile - , group -- group :: Monad m => ByteString m r -> Stream (ByteString m) m r - , groupBy - , span -- span :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m (ByteString m r) - , splitAt -- splitAt :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m (ByteString m r) - , splitWith -- splitWith :: Monad m => (Char -> Bool) -> ByteString m r -> Stream (ByteString m) m r - , take -- take :: Monad m => GHC.Int.Int64 -> ByteString m r -> ByteString m () - , takeWhile -- takeWhile :: (Char -> Bool) -> ByteString m r -> ByteString m () - - -- ** Breaking into many substrings - , split -- split :: Monad m => Char -> ByteString m r -> Stream (ByteString m) m r - , lines - , words - , lineSplit - , denull - - -- ** Special folds - , concat -- concat :: Monad m => Stream (ByteString m) m r -> ByteString m r - - -- * Builders - - , toStreamingByteString - , toStreamingByteStringWith - , toBuilder - , concatBuilders - - -- * Building ByteStrings - - -- ** Infinite ByteStrings - , repeat -- repeat :: Char -> ByteString m () - , iterate -- iterate :: (Char -> Char) -> Char -> ByteString m () - , cycle -- cycle :: Monad m => ByteString m r -> ByteString m s - - -- ** Unfolding ByteStrings - , unfoldr -- unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteString m () - , unfoldM -- unfold :: (a -> Either r (Char, a)) -> a -> ByteString m r - , reread - - -- * Folds, including support for `Control.Foldl` --- , foldr -- foldr :: Monad m => (Char -> a -> a) -> a -> ByteString m () -> m a - , fold -- fold :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteString m () -> m b - , fold_ -- fold' :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteString m r -> m (b, r) - , length - , length_ - , count - , count_ - , readInt - -- * I\/O with 'ByteString's - - -- ** Standard input and output - , getContents -- getContents :: ByteString IO () - , stdin -- stdin :: ByteString IO () - , stdout -- stdout :: ByteString IO r -> IO r - , interact -- interact :: (ByteString IO () -> ByteString IO r) -> IO r - , putStr - , putStrLn - - -- ** Files - , readFile -- readFile :: FilePath -> ByteString IO () - , writeFile -- writeFile :: FilePath -> ByteString IO r -> IO r - , appendFile -- appendFile :: FilePath -> ByteString IO r -> IO r - - -- ** I\/O with Handles - , fromHandle -- fromHandle :: Handle -> ByteString IO () - , toHandle -- toHandle :: Handle -> ByteString IO r -> IO r - , hGet -- hGet :: Handle -> Int -> ByteString IO () - , hGetContents -- hGetContents :: Handle -> ByteString IO () - , hGetContentsN -- hGetContentsN :: Int -> Handle -> ByteString IO () - , hGetN -- hGetN :: Int -> Handle -> Int -> ByteString IO () - , hGetNonBlocking -- hGetNonBlocking :: Handle -> Int -> ByteString IO () - , hGetNonBlockingN -- hGetNonBlockingN :: Int -> Handle -> Int -> ByteString IO () - , hPut -- hPut :: Handle -> ByteString IO r -> IO r --- , hPutNonBlocking -- hPutNonBlocking :: Handle -> ByteString IO r -> ByteString IO r - - -- * Simple chunkwise operations - , unconsChunk - , nextChunk - , chunk - , foldrChunks - , foldlChunks - , chunkFold - , chunkFoldM - , chunkMap - , chunkMapM - , chunkMapM_ - - -- * Etc. --- , zipWithStream -- zipWithStream :: Monad m => (forall x. a -> ByteString m x -> ByteString m x) -> [a] -> Stream (ByteString m) m r -> Stream (ByteString m) m r - , distribute -- distribute :: ByteString (t m) a -> t (ByteString m) a - , materialize - , dematerialize - ) where - -import Prelude hiding - (reverse,head,tail,last,init,null,length,map,words, lines,foldl,foldr, unwords, unlines - ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter,maximum - ,minimum,all,concatMap,foldl1,foldr1,scanl, scanl1, scanr, scanr1 - ,repeat, cycle, interact, iterate,readFile,writeFile,appendFile,replicate - ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) -import qualified Prelude - -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B -import Data.ByteString.Internal (c2w,w2c) -import qualified Data.ByteString.Unsafe as B -import qualified Data.ByteString.Char8 as Char8 - -import Streaming hiding (concats, unfold, distribute, mwrap) -import Streaming.Internal (Stream (..)) -import qualified Streaming.Prelude as S -import qualified Streaming as S - -import qualified Data.ByteString.Streaming as R -import Data.ByteString.Streaming.Internal - -import Data.ByteString.Streaming - (fromLazy, toLazy, toLazy_, nextChunk, unconsChunk, - fromChunks, toChunks, fromStrict, toStrict, toStrict_, - concat, distribute, effects, drained, mwrap, toStreamingByteStringWith, - toStreamingByteString, toBuilder, concatBuilders, - empty, null, nulls, null_, testNull, length, length_, append, cycle, - take, drop, splitAt, intercalate, group, denull, - appendFile, stdout, stdin, fromHandle, toHandle, - hGetContents, hGetContentsN, hGet, hGetN, hPut, - getContents, hGetNonBlocking, - hGetNonBlockingN, readFile, writeFile, interact, - chunkFold, chunkFoldM, chunkMap, chunkMapM) - -- hPutNonBlocking, - -import Control.Monad (liftM) -import System.IO (Handle,openBinaryFile,IOMode(..) - ,hClose) -import qualified System.IO as IO -import System.IO.Unsafe -import Control.Exception (bracket) -import Data.Char (isDigit) -import Data.Word (Word8) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr -import Foreign.Storable -import Data.Functor.Compose -import Data.Functor.Sum -import qualified Data.List as L - -unpack :: Monad m => ByteString m r -> Stream (Of Char) m r -unpack bs = case bs of - Empty r -> Return r - Go m -> Effect (liftM unpack m) - Chunk c cs -> unpackAppendCharsLazy c (unpack cs) - where - unpackAppendCharsLazy :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r - unpackAppendCharsLazy (B.PS fp off len) xs - | len <= 100 = unpackAppendCharsStrict (B.PS fp off len) xs - | otherwise = unpackAppendCharsStrict (B.PS fp off 100) remainder - where - remainder = unpackAppendCharsLazy (B.PS fp (off+100) (len-100)) xs - - unpackAppendCharsStrict :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r - unpackAppendCharsStrict (B.PS fp off len) xs = - inlinePerformIO $ withForeignPtr fp $ \base -> do - loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs - where - loop !sentinal !p acc - | p == sentinal = return acc - | otherwise = do x <- peek p - loop sentinal (p `plusPtr` (-1)) (Step (B.w2c x :> acc)) -{-# INLINABLE unpack#-} - - --- | /O(n)/ Convert a stream of separate characters into a packed byte stream. -pack :: Monad m => Stream (Of Char) m r -> ByteString m r -pack = fromChunks - . mapped (liftM (\(str :> r) -> Char8.pack str :> r) . S.toList) - . chunksOf 32 -{-# INLINABLE pack #-} - --- | /O(1)/ Cons a 'Char' onto a byte stream. -cons :: Monad m => Char -> ByteString m r -> ByteString m r -cons c = R.cons (c2w c) -{-# INLINE cons #-} - --- | /O(1)/ Yield a 'Char' as a minimal 'ByteString' -singleton :: Monad m => Char -> ByteString m () -singleton = R.singleton . 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 ByteStrings. --- -cons' :: Char -> ByteString m r -> ByteString m r -cons' c (Chunk bs bss) | B.length bs < 16 = Chunk (B.cons (c2w c) bs) bss -cons' c cs = Chunk (B.singleton (c2w c)) cs -{-# INLINE cons' #-} --- --- | /O(n\/c)/ Append a byte to the end of a 'ByteString' -snoc :: Monad m => ByteString m r -> Char -> ByteString m r -snoc cs = R.snoc cs . c2w -{-# INLINE snoc #-} - --- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. -head_ :: Monad m => ByteString m r -> m Char -head_ = liftM (w2c) . R.head_ -{-# INLINE head_ #-} - --- | /O(1)/ Extract the first element of a ByteString, which may be non-empty -head :: Monad m => ByteString m r -> m (Of (Maybe Char) r) -head = liftM (\(m:>r) -> fmap w2c m :> r) . R.head -{-# INLINE head #-} - --- | /O(n\/c)/ Extract the last element of a ByteString, which must be finite --- and non-empty. -last_ :: Monad m => ByteString m r -> m Char -last_ = liftM (w2c) . R.last_ -{-# INLINE last_ #-} - -last :: Monad m => ByteString m r -> m (Of (Maybe Char) r) -last = liftM (\(m:>r) -> fmap (w2c) m :> r) . R.last -{-# INLINE last #-} - -groupBy :: Monad m => (Char -> Char -> Bool) -> ByteString m r -> Stream (ByteString m) m r -groupBy rel = R.groupBy (\w w' -> rel (w2c w) (w2c w')) -{-#INLINE groupBy #-} - --- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing --- if it is empty. -uncons :: Monad m => ByteString m r -> m (Either r (Char, ByteString m r)) -uncons (Empty r) = return (Left r) -uncons (Chunk c cs) - = return $ Right (w2c (B.unsafeHead c) - , if B.length c == 1 - then cs - else Chunk (B.unsafeTail c) cs ) -uncons (Go m) = m >>= uncons -{-# INLINABLE uncons #-} - --- --------------------------------------------------------------------- --- Transformations - --- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each --- element of @xs@. -map :: Monad m => (Char -> Char) -> ByteString m r -> ByteString m r -map f = R.map (c2w . f . w2c) -{-# INLINE map #-} --- --- -- | /O(n)/ 'reverse' @xs@ returns the elements of @xs@ in reverse order. --- reverse :: ByteString -> ByteString --- reverse cs0 = rev Empty cs0 --- where rev a Empty = a --- rev a (Chunk c cs) = rev (Chunk (B.reverse c) a) cs --- {-# INLINE reverse #-} --- --- -- | The 'intersperse' function takes a 'Word8' and a 'ByteString' and --- -- \`intersperses\' that byte between the elements of the 'ByteString'. --- -- It is analogous to the intersperse function on Streams. -intersperse :: Monad m => Char -> ByteString m r -> ByteString m r -intersperse c = R.intersperse (c2w c) -{-#INLINE intersperse #-} --- -- | The 'transpose' function transposes the rows and columns of its --- -- 'ByteString' argument. --- transpose :: [ByteString] -> [ByteString] --- transpose css = L.map (\ss -> Chunk (B.pack ss) Empty) --- (L.transpose (L.map unpack css)) --- --TODO: make this fast --- --- -- --------------------------------------------------------------------- --- -- Reducing 'ByteString's -fold_ :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteString m () -> m b -fold_ step begin done p0 = loop p0 begin - where - loop p !x = case p of - Chunk bs bss -> loop bss $! Char8.foldl' step x bs - Go m -> m >>= \p' -> loop p' x - Empty _ -> return (done x) -{-# INLINABLE fold_ #-} - - -fold :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteString m r -> m (Of b r) -fold step begin done p0 = loop p0 begin - where - loop p !x = case p of - Chunk bs bss -> loop bss $! Char8.foldl' step x bs - Go m -> m >>= \p' -> loop p' x - Empty r -> return (done x :> r) -{-# INLINABLE fold #-} --- --------------------------------------------------------------------- --- Unfolds and replicates - --- | @'iterate' f x@ returns an infinite ByteString of repeated applications --- of @f@ to @x@: - --- > iterate f x == [x, f x, f (f x), ...] - -iterate :: (Char -> Char) -> Char -> ByteString m r -iterate f c = R.iterate (c2w . f . w2c) (c2w c) -{-#INLINE iterate #-} - --- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every --- element. --- -repeat :: Char -> ByteString m r -repeat = R.repeat . c2w -{-#INLINE repeat #-} - --- -- | /O(n)/ @'replicate' n x@ is a ByteString of length @n@ with @x@ --- -- the value of every element. --- -- --- replicate :: Int64 -> Word8 -> ByteString --- replicate n w --- | n <= 0 = Empty --- | n < fromIntegral smallChunkSize = Chunk (B.replicate (fromIntegral n) w) Empty --- | r == 0 = cs -- preserve invariant --- | otherwise = Chunk (B.unsafeTake (fromIntegral r) c) cs --- where --- c = B.replicate smallChunkSize w --- cs = nChunks q --- (q, r) = quotRem n (fromIntegral smallChunkSize) --- nChunks 0 = Empty --- nChunks m = Chunk c (nChunks (m-1)) - --- | 'cycle' ties a finite ByteString into a circular one, or equivalently, --- the infinite repetition of the original ByteString. --- --- | /O(n)/ The 'unfoldr' function is analogous to the Stream \'unfoldr\'. --- 'unfoldr' builds a ByteString from a seed value. The function takes --- the element and returns 'Nothing' if it is done producing the --- ByteString or returns 'Just' @(a,b)@, in which case, @a@ is a --- prepending to the ByteString and @b@ is used as the next element in a --- recursive call. -unfoldM :: Monad m => (a -> Maybe (Char, a)) -> a -> ByteString m () -unfoldM f = R.unfoldM go where - go a = case f a of - Nothing -> Nothing - Just (c,a) -> Just (c2w c, a) -{-#INLINE unfoldM #-} - - -unfoldr :: (a -> Either r (Char, a)) -> a -> ByteString m r -unfoldr step = R.unfoldr (either Left (\(c,a) -> Right (c2w c,a)) . step) -{-#INLINE unfoldr #-} - - --- --------------------------------------------------------------------- - - --- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, --- returns the longest prefix (possibly empty) of @xs@ of elements that --- satisfy @p@. -takeWhile :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m () -takeWhile f = R.takeWhile (f . w2c) -{-#INLINE takeWhile #-} - --- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. - -dropWhile :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m r -dropWhile f = R.dropWhile (f . w2c) -{-#INLINE dropWhile #-} - -{- | 'break' @p@ is equivalent to @'span' ('not' . p)@. - --} -break :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m (ByteString m r) -break f = R.break (f . w2c) -{-#INLINE break #-} - --- --- | 'span' @p xs@ breaks the ByteString into two segments. It is --- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ -span :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m (ByteString m r) -span p = break (not . p) -{-#INLINE span #-} - --- -- | /O(n)/ Splits a 'ByteString' into components delimited by --- -- separators, where the predicate returns True for a separator element. --- -- The resulting components do not contain the separators. Two adjacent --- -- separators result in an empty component in the output. eg. --- -- --- -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] --- -- > splitWith (=='a') [] == [] --- -- -splitWith :: Monad m => (Char -> Bool) -> ByteString m r -> Stream (ByteString m) m r -splitWith f = R.splitWith (f . w2c) -{-# INLINE splitWith #-} - -{- | /O(n)/ Break a 'ByteString' 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 'ByteStrings' that -are slices of the original. - ->>> Q.stdout $ Q.unlines $ Q.split 'n' "banana peel" -ba -a -a peel --} -split :: Monad m => Char -> ByteString m r -> Stream (ByteString m) m r -split c = R.split (c2w c) -{-# INLINE split #-} --- -- --------------------------------------------------------------------- --- -- Searching ByteStrings --- --- -- | /O(n)/ 'elem' is the 'ByteString' membership predicate. --- elem :: Word8 -> ByteString -> Bool --- elem w cs = case elemIndex w cs of Nothing -> False ; _ -> True --- --- -- | /O(n)/ 'notElem' is the inverse of 'elem' --- notElem :: Word8 -> ByteString -> Bool --- notElem w cs = not (elem w cs) - --- | /O(n)/ 'filter', applied to a predicate and a ByteString, --- returns a ByteString containing those characters that satisfy the --- predicate. -filter :: Monad m => (Char -> Bool) -> ByteString m r -> ByteString m r -filter p = R.filter (p . w2c) -{-# INLINE filter #-} - - - -{- | 'lines' turns a ByteString into a connected stream of ByteStrings 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 'ByteString'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 => ByteString m r -> Stream (ByteString m) m r -lines text0 = loop1 text0 - where - loop1 :: ByteString m r -> Stream (ByteString m) m r - loop1 text = - case text of - Empty r -> Return r - Go m -> Effect $ liftM loop1 m - Chunk c cs - | B.null c -> loop1 cs - | otherwise -> Step (loop2 False text) - loop2 :: Bool -> ByteString m r -> ByteString m (Stream (ByteString m) m r) - loop2 prevCr text = - case text of - Empty r -> if prevCr - then Chunk (B.singleton 13) (Empty (Return r)) - else Empty (Return r) - Go m -> Go $ liftM (loop2 prevCr) m - Chunk c cs -> - case B.elemIndex 10 c of - Nothing -> if B.null c - then loop2 prevCr cs - else if unsafeLast c == 13 - then Chunk (unsafeInit c) (loop2 True cs) - else Chunk c (loop2 False cs) - Just i -> do - let prefixLength = - if i >= 1 && B.unsafeIndex c (i-1) == 13 -- \r\n (dos) - then i-1 - else i - rest = - if B.length c > i+1 - then Chunk (B.drop (i+1) c) cs - else cs - result = Chunk (B.unsafeTake prefixLength c) (Empty (loop1 rest)) - if i > 0 && prevCr - then Chunk (B.singleton 13) result - else 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 (ByteString m) m r -> ByteString m r -unlines = loop where - loop str = case str of - Return r -> Empty r - Step bstr -> do - st <- bstr - let bs = unlines st - case bs of - Chunk "" (Empty r) -> Empty r - Chunk "\n" (Empty r) -> bs - _ -> cons' '\n' bs - Effect m -> Go (liftM unlines m) -{-#INLINABLE unlines #-} - --- | 'words' breaks a byte stream up into a succession of byte streams --- corresponding to words, breaking Chars 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. It is best for the user who --- has reflected on her materials to write `mapped toStrict . words` or the like, --- if strict bytestrings are needed. -words :: Monad m => ByteString m r -> Stream (ByteString m) m r -words = filtered . R.splitWith B.isSpaceWord8 - where - filtered stream = case stream of - Return r -> Return r - Effect m -> Effect (liftM filtered m) - Step bs -> Effect $ bs_loop bs - bs_loop bs = case bs of - Empty r -> return $ filtered r - Go m -> m >>= bs_loop - Chunk b bs' -> if B.null b - then bs_loop bs' - else return $ Step $ Chunk b (fmap filtered bs') -{-# INLINABLE words #-} - --- | The 'unwords' function is analogous to the 'unlines' function, on words. -unwords :: Monad m => Stream (ByteString m) m r -> ByteString m r -unwords = intercalate (singleton ' ') -{-# INLINE unwords #-} - - -{- | 'lineSplit' turns a ByteString into a connected stream of ByteStrings 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 - -> ByteString m r -- ^ stream of bytes - -> Stream (ByteString m) m r -lineSplit !n0 text0 = loop1 0 text0 - where - n :: Int - !n = max n0 1 - loop1 :: Int -> ByteString m r -> Stream (ByteString m) m r - loop1 !counter text = - case text of - Empty r -> Return r - Go m -> Effect $ liftM (loop1 counter) m - Chunk c cs - | B.null c -> loop1 counter cs - | otherwise -> Step (loop2 counter text) - loop2 :: Int -> ByteString m r -> ByteString m (Stream (ByteString m) m r) - loop2 !counter text = - case text of - Empty r -> Empty (Return r) - Go m -> Go $ liftM (loop2 counter) m - Chunk c cs -> - let !numNewlines = B.count newline c - !newCounter = counter + numNewlines - in if newCounter >= n - then case Prelude.drop (n - counter - 1) (B.findIndices (== newline) c) of - i : _ -> - let !j = i + 1 - in Chunk (B.unsafeTake j c) (Empty (loop1 0 (Chunk (B.unsafeDrop j c) cs))) - -- the empty list cannot happen unless Data.ByteString.count or - -- Data.ByteString.findIndices is misimplemented. The expression - -- that handles this case is only here to satisfy the type - -- checker. - [] -> loop2 0 cs - else Chunk c (loop2 newCounter cs) -{-#INLINABLE lineSplit #-} - -newline :: Word8 -newline = 10 -{-# INLINE newline #-} - -string :: String -> ByteString m () -string = chunk . B.pack . Prelude.map B.c2w -{-# INLINE string #-} - - -count_ :: Monad m => Char -> ByteString m r -> m Int -count_ c = R.count_ (c2w c) -{-# INLINE count_ #-} - -count :: Monad m => Char -> ByteString m r -> m (Of Int r) -count c = R.count (c2w c) -{-# INLINE count #-} - -nextChar :: Monad m => ByteString m r -> m (Either r (Char, ByteString m r)) -nextChar b = do - e <- R.nextByte b - case e of - Left r -> return $! Left r - Right (w,bs) -> return $! Right (w2c w, bs) - -putStr :: MonadIO m => ByteString m r -> m r -putStr = hPut IO.stdout -{-#INLINE putStr #-} - -putStrLn :: MonadIO m => ByteString m r -> m r -putStrLn bs = hPut IO.stdout (snoc bs '\n') -{-#INLINE putStrLn #-} --- , head' --- , last --- , last' --- , length --- , length' --- , null --- , null' --- , count --- , count' - -{-| This will read positive or negative Ints that require 18 or fewer characters. --} -readInt :: Monad m => ByteString m r -> m (Compose (Of (Maybe Int)) (ByteString m) r) -readInt = go . toStrict . splitAt 18 where - go m = do - (bs :> rest) <- m - case Char8.readInt bs of - Nothing -> return (Compose (Nothing :> (chunk bs >> rest))) - Just (n,more) -> if B.null more - then do - e <- uncons rest - return $ case e of - Left r -> Compose (Just n :> return r) - Right (c,rest') -> if isDigit c - then Compose (Nothing :> (chunk bs >> cons' c rest')) - else Compose (Just n :> (chunk more >> cons' c rest')) - else return (Compose (Just n :> (chunk more >> rest))) -{-#INLINABLE readInt #-} - - -- uncons :: Monad m => ByteString m r -> m (Either r (Char, ByteString m r)) diff --git a/Data/ByteString/Streaming/Internal.hs b/Data/ByteString/Streaming/Internal.hs deleted file mode 100644 --- a/Data/ByteString/Streaming/Internal.hs +++ /dev/null @@ -1,542 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, RankNTypes, GADTs #-} -{-# LANGUAGE UnliftedFFITypes, MagicHash, UnboxedTuples #-} -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} - -module Data.ByteString.Streaming.Internal ( - ByteString (..) - , consChunk -- :: S.ByteString -> ByteString m r -> ByteString m r - , chunkOverhead -- :: Int - , defaultChunkSize -- :: Int - , materialize -- :: (forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x) -> ByteString m r - , dematerialize -- :: Monad m => ByteString m r -> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x - , foldrChunks -- :: Monad m => (ByteString -> a -> a) -> a -> ByteString m r -> m a - , foldlChunks -- :: Monad m => (a -> ByteString -> a) -> a -> ByteString m r -> m a - - , foldrChunksM -- :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteString m r -> m a - , foldlChunksM -- :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteString m r -> m a - , chunkFold - , chunkFoldM - , chunkMap - , chunkMapM - , chunkMapM_ - , unfoldMChunks - , unfoldrChunks - - , packChars - , smallChunkSize -- :: Int - , unpackBytes -- :: Monad m => ByteString m r -> Stream Word8_ m r - , packBytes - , chunk -- :: ByteString -> ByteString m () - , mwrap - , unfoldrNE - , reread - , inlinePerformIO - , unsafeLast - , unsafeInit - , copy - - -- * ResourceT help - , bracketByteString - ) where - -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,maximum - ,minimum,all,concatMap,foldl1,foldr1,scanl, scanl1, scanr, scanr1 - ,repeat, cycle, interact, iterate,readFile,writeFile,appendFile,replicate - ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) -import qualified Prelude -import Control.Monad.Trans -import Control.Monad -import Control.Applicative -import Control.Monad.Morph -import Data.Monoid (Monoid(..)) - -#if __GLASGOW_HASKELL__ < 841 -import Data.Semigroup -#endif - -import qualified Data.ByteString as S -- S for strict (hmm...) -import qualified Data.ByteString.Internal as S - -import Streaming (Of(..)) -import Streaming.Internal hiding (concats, mwrap, step) -import qualified Streaming.Prelude as SP - -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr -import Foreign.Storable -import GHC.Exts ( SpecConstrAnnotation(..) ) -import Data.String - -import Data.Functor.Identity -import Data.Word -import System.IO.Unsafe -import GHC.Base (realWorld#,unsafeChr) -import GHC.IO (IO(IO)) - -import Control.Monad.Base -import Control.Monad.Trans.Resource -import Control.Monad.Catch (MonadCatch (..)) - --- | A space-efficient representation of a succession of 'Word8' vectors, supporting many --- efficient operations. --- --- An effectful 'ByteString' contains 8-bit bytes, or by using the operations --- from "Data.ByteString.Streaming.Char8" it can be interpreted as containing --- 8-bit characters. - -data ByteString m r = - Empty r - | Chunk {-#UNPACK #-} !S.ByteString (ByteString m r ) - | Go (m (ByteString m r )) - -instance Monad m => Functor (ByteString m) where - fmap f x = case x of - Empty a -> Empty (f a) - Chunk bs bss -> Chunk bs (fmap f bss) - Go mbss -> Go (liftM (fmap f) mbss) - -instance Monad m => Applicative (ByteString m) where - pure = Empty - {-#INLINE pure #-} - bf <*> bx = do {f <- bf; x <- bx; Empty (f x)} - {-#INLINE (<*>) #-} - (*>) = (>>) - {-#INLINE (*>) #-} - -instance Monad m => Monad (ByteString m) where - return = Empty - {-#INLINE return #-} - x0 >> y = loop SPEC x0 where - loop !_ x = case x of -- this seems to be insanely effective - Empty _ -> y - Chunk a b -> Chunk a (loop SPEC b) - Go m -> Go (liftM (loop SPEC) m) - {-#INLINEABLE (>>)#-} - x >>= f = - -- case x of - -- Empty a -> f a - -- Chunk bs bss -> Chunk bs (bss >>= f) - -- Go mbss -> Go (liftM (>>= f) mbss) - loop SPEC2 x where -- unlike >> this SPEC seems pointless - loop !_ y = case y of - Empty a -> f a - Chunk bs bss -> Chunk bs (loop SPEC bss) - Go mbss -> Go (liftM (loop SPEC) mbss) - {-#INLINEABLE (>>=) #-} - -instance MonadIO m => MonadIO (ByteString m) where - liftIO io = Go (liftM Empty (liftIO io)) - {-#INLINE liftIO #-} - -instance MonadTrans ByteString where - lift ma = Go $ liftM Empty ma - {-#INLINE lift #-} - -instance MFunctor ByteString where - hoist phi bs = case bs of - Empty r -> Empty r - Chunk bs' rest -> Chunk bs' (hoist phi rest) - Go m -> Go (phi (liftM (hoist phi) m)) - {-#INLINABLE hoist #-} - -instance (r ~ ()) => IsString (ByteString m r) where - fromString = chunk . S.pack . Prelude.map S.c2w - {-#INLINE fromString #-} - -instance (m ~ Identity, Show r) => Show (ByteString m r) where - show bs0 = case bs0 of -- the implementation this instance deserves ... - Empty r -> "Empty (" ++ show r ++ ")" - Go (Identity bs') -> "Go (Identity (" ++ show bs' ++ "))" - Chunk bs'' bs -> "Chunk " ++ show bs'' ++ " (" ++ show bs ++ ")" - -instance (Semigroup r, Monad m) => Semigroup (ByteString m r) where - (<>) = liftM2 (<>) - {-# INLINE (<>) #-} - -instance (Monoid r, Monad m) => Monoid (ByteString m r) where - mempty = Empty mempty - {-# INLINE mempty #-} - mappend = liftM2 mappend - {-# INLINE mappend #-} - -instance (MonadBase b m) => MonadBase b (ByteString m) where - liftBase = mwrap . fmap return . liftBase - {-#INLINE liftBase #-} - -instance (MonadThrow m) => MonadThrow (ByteString m) where - throwM = lift . throwM - {-#INLINE throwM #-} - -instance (MonadCatch m) => MonadCatch (ByteString m) where - catch str f = go str - where - go p = case p of - Chunk bs rest -> Chunk bs (go rest) - Empty r -> Empty r - Go m -> Go (catch (do - p' <- m - return (go p')) - (\e -> return (f e)) ) - {-#INLINABLE catch #-} - -instance (MonadResource m) => MonadResource (ByteString m) where - liftResourceT = lift . liftResourceT - {-#INLINE liftResourceT #-} - -bracketByteString :: (MonadResource m) => - IO a -> (a -> IO ()) -> (a -> ByteString m b) -> ByteString m b -bracketByteString alloc free inside = do - (key, seed) <- lift (allocate alloc free) - clean key (inside seed) - where - clean key = loop where - loop str = case str of - Empty r -> Go (release key >> return (Empty r)) - Go m -> Go (liftM loop m) - Chunk bs rest -> Chunk bs (loop rest) -{-#INLINABLE bracketByteString #-} - - -data SPEC = SPEC | SPEC2 -{-# ANN type SPEC ForceSpecConstr #-} - --- -- ------------------------------------------------------------------------ --- --- | Smart constructor for 'Chunk'. -consChunk :: S.ByteString -> ByteString m r -> ByteString m r -consChunk c@(S.PS _ _ len) cs - | len == 0 = cs - | otherwise = Chunk c cs -{-# INLINE consChunk #-} - --- | Yield-style smart constructor for 'Chunk'. -chunk :: S.ByteString -> ByteString m () -chunk bs = consChunk bs (Empty ()) -{-# INLINE chunk #-} - - -{- | Reconceive an effect that results in an effectful bytestring as an effectful bytestring. - Compare Streaming.mwrap. The closes equivalent of - ->>> Streaming.wrap :: f (Stream f m r) -> Stream f m r - - is here @consChunk@. @mwrap@ is the smart constructor for the internal @Go@ constructor. --} -mwrap :: m (ByteString m r) -> ByteString m r -mwrap = Go -{-# INLINE mwrap #-} - --- | Construct a succession of chunks from its Church encoding (compare @GHC.Exts.build@) -materialize :: (forall x . (r -> x) -> (S.ByteString -> x -> x) -> (m x -> x) -> x) - -> ByteString m r -materialize phi = phi Empty Chunk Go -{-#INLINE[0] materialize #-} - --- | Resolve a succession of chunks into its Church encoding; this is --- not a safe operation; it is equivalent to exposing the constructors -dematerialize :: Monad m - => ByteString m r - -> (forall x . (r -> x) -> (S.ByteString -> x -> x) -> (m x -> x) -> x) -dematerialize x0 nil cons mwrap = loop SPEC x0 - where - loop !_ x = case x of - Empty r -> nil r - Chunk b bs -> cons b (loop SPEC bs ) - Go ms -> mwrap (liftM (loop SPEC) ms) -{-# INLINE [1] dematerialize #-} - -{-# RULES - "dematerialize/materialize" forall (phi :: forall b . (r -> b) -> (S.ByteString -> b -> b) -> (m b -> b) -> b). dematerialize (materialize phi) = phi ; - #-} ------------------------------------------------------------------------- - --- The representation uses lists of packed chunks. When we have to convert from --- a lazy list to the chunked representation, then by default we use this --- chunk size. Some functions give you more control over the chunk size. --- --- Measurements here: --- http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png --- --- indicate that a value around 0.5 to 1 x your L2 cache is best. --- The following value assumes people have something greater than 128k, --- and need to share the cache with other programs. - --- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead -defaultChunkSize :: Int -defaultChunkSize = 32 * k - chunkOverhead - where k = 1024 -{-#INLINE defaultChunkSize #-} --- | The recommended chunk size. Currently set to 4k, less the memory management overhead -smallChunkSize :: Int -smallChunkSize = 4 * k - chunkOverhead - where k = 1024 -{-#INLINE smallChunkSize #-} - --- | The memory management overhead. Currently this is tuned for GHC only. -chunkOverhead :: Int -chunkOverhead = 2 * sizeOf (undefined :: Int) -{-#INLINE chunkOverhead #-} --- ------------------------------------------------------------------------ --- | Packing and unpacking from lists --- packBytes' :: Monad m => [Word8] -> ByteString m () --- packBytes' cs0 = --- packChunks 32 cs0 --- where --- packChunks n cs = case S.packUptoLenBytes n cs of --- (bs, []) -> Chunk bs (Empty ()) --- (bs, cs') -> Chunk bs (packChunks (min (n * 2) BI.smallChunkSize) cs') --- -- packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) --- packUptoLenBytes len xs0 = --- unsafeDupablePerformIO (createUptoN' len $ \p -> go p len xs0) --- where --- go !_ !n [] = return (len-n, []) --- go !_ !0 xs = return (len, xs) --- go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs --- createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (S.ByteString, a) --- createUptoN' l f = do --- fp <- S.mallocByteString l --- (l', res) <- withForeignPtr fp $ \p -> f p --- assert (l' <= l) $ return (S.PS fp 0 l', res) --- {-#INLINABLE packBytes' #-} - -packBytes :: Monad m => Stream (Of Word8) m r -> ByteString m r -packBytes cs0 = do - (bytes :> rest) <- lift $ SP.toList $ SP.splitAt 32 cs0 - case bytes of - [] -> case rest of - Return r -> Empty r - Step as -> packBytes (Step as) -- these two pattern matches - Effect m -> Go $ liftM packBytes m -- should be evaded. - _ -> Chunk (S.packBytes bytes) (packBytes rest) -{-#INLINABLE packBytes #-} - -packChars :: Monad m => Stream (Of Char) m r -> ByteString m r -packChars = packBytes . SP.map S.c2w -{-#INLINABLE packChars #-} - - - -unpackBytes :: Monad m => ByteString m r -> Stream (Of Word8) m r -unpackBytes bss = dematerialize bss - Return - unpackAppendBytesLazy - Effect - where - unpackAppendBytesLazy :: S.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r - unpackAppendBytesLazy (S.PS fp off len) xs - | len <= 100 = unpackAppendBytesStrict (S.PS fp off len) xs - | otherwise = unpackAppendBytesStrict (S.PS fp off 100) remainder - where - remainder = unpackAppendBytesLazy (S.PS fp (off+100) (len-100)) xs - - unpackAppendBytesStrict :: S.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r - unpackAppendBytesStrict (S.PS fp off len) xs = - inlinePerformIO $ withForeignPtr fp $ \base -> do - loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs - where - accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r - loop !sentinal !p acc - | p == sentinal = return acc - | otherwise = do x <- peek p - loop sentinal (p `plusPtr` (-1)) (Step (x :> acc)) -{-# INLINABLE unpackBytes #-} - --- copied from Data.ByteString.Unsafe for compatibility with older bytestring -unsafeLast :: S.ByteString -> Word8 -unsafeLast (S.PS x s l) = - accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1) - where - accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -{-# INLINE unsafeLast #-} - --- copied from Data.ByteString.Unsafe for compatibility with older bytestring -unsafeInit :: S.ByteString -> S.ByteString -unsafeInit (S.PS ps s l) = S.PS ps s (l-1) -{-# INLINE unsafeInit #-} - -inlinePerformIO :: IO a -> a -inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r - --- | Consume the chunks of an effectful ByteString with a natural right fold. -foldrChunks :: Monad m => (S.ByteString -> a -> a) -> a -> ByteString m r -> m a -foldrChunks step nil bs = dematerialize bs - (\_ -> return nil) - (liftM . step) - join -{-# INLINE foldrChunks #-} - -foldlChunks :: Monad m => (a -> S.ByteString -> a) -> a -> ByteString m r -> m (Of a r) -foldlChunks f z = go z - where go a _ | a `seq` False = undefined - go a (Empty r) = return (a :> r) - go a (Chunk c cs) = go (f a c) cs - go a (Go m) = m >>= go a -{-# INLINABLE foldlChunks #-} - -chunkMap :: Monad m => (S.ByteString -> S.ByteString) -> ByteString m r -> ByteString m r -chunkMap f bs = dematerialize bs return (\bs bss -> Chunk (f bs) bss) Go -{-#INLINE chunkMap #-} - -chunkMapM :: Monad m => (S.ByteString -> m S.ByteString) -> ByteString m r -> ByteString m r -chunkMapM f bs = dematerialize bs return (\bs bss -> Go (liftM (flip Chunk bss) (f bs))) Go -{-#INLINE chunkMapM #-} - -chunkMapM_ :: Monad m => (S.ByteString -> m x) -> ByteString m r -> m r -chunkMapM_ f bs = dematerialize bs return (\bs mr -> f bs >> mr) join -{-#INLINE chunkMapM_ #-} - - -{- | @chunkFold@ is preferable to @foldlChunks@ since it is - an appropriate argument for @Control.Foldl.purely@ which - permits many folds and sinks to be run simulaneously on one bytestream. - - -} -chunkFold :: Monad m => (x -> S.ByteString -> x) -> x -> (x -> a) -> ByteString m r -> m (Of a r) -chunkFold step begin done = go begin - where go a _ | a `seq` False = undefined - go a (Empty r) = return (done a :> r) - go a (Chunk c cs) = go (step a c) cs - go a (Go m) = m >>= go a -{-# INLINABLE chunkFold #-} - -{- | @chunkFoldM@ is preferable to @foldlChunksM@ since it is - an appropriate argument for @Control.Foldl.impurely@ which - permits many folds and sinks to be run simulaneously on one bytestream. - - -} -chunkFoldM :: Monad m => (x -> S.ByteString -> m x) -> m x -> (x -> m a) -> ByteString m r -> m (Of a r) -chunkFoldM step begin done bs = begin >>= go bs - where - go str !x = case str of - Empty r -> done x >>= \a -> return (a :> r) - Chunk c cs -> step x c >>= go cs - Go m -> m >>= \str' -> go str' x -{-# INLINABLE chunkFoldM #-} - -foldlChunksM :: Monad m => (a -> S.ByteString -> m a) -> m a -> ByteString m r -> m (Of a r) -foldlChunksM f z bs = z >>= \a -> go a bs - where - go !a str = case str of - Empty r -> return (a :> r) - Chunk c cs -> f a c >>= \aa -> go aa cs - Go m -> m >>= go a -{-# INLINABLE foldlChunksM #-} - - - --- | Consume the chunks of an effectful ByteString with a natural right monadic fold. -foldrChunksM :: Monad m => (S.ByteString -> m a -> m a) -> m a -> ByteString m r -> m a -foldrChunksM step nil bs = dematerialize bs - (\_ -> nil) - step - join -{-# INLINE foldrChunksM #-} - -unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (S.ByteString, Either r a) -unfoldrNE i f x0 - | i < 0 = (S.empty, Right x0) - | otherwise = unsafePerformIO $ S.createAndTrim' i $ \p -> go p x0 0 - where - go !p !x !n - | n == i = return (0, n, Right x) - | otherwise = case f x of - Left r -> return (0, n, Left r) - Right (w,x') -> do poke p w - go (p `plusPtr` 1) x' (n+1) -{-# INLINE unfoldrNE #-} - - -unfoldMChunks :: Monad m => (s -> m (Maybe (S.ByteString, s))) -> s -> ByteString m () -unfoldMChunks step = loop where - loop s = Go $ do - m <- step s - case m of - Nothing -> return (Empty ()) - Just (bs,s') -> return $ Chunk bs (loop s') -{-# INLINABLE unfoldMChunks #-} - -unfoldrChunks :: Monad m => (s -> m (Either r (S.ByteString, s))) -> s -> ByteString m r -unfoldrChunks step = loop where - loop !s = Go $ do - m <- step s - case m of - Left r -> return (Empty r) - Right (bs,s') -> return $ Chunk bs (loop s') -{-# INLINABLE unfoldrChunks #-} - - -{-| Stream chunks from something that contains @IO (Maybe ByteString)@ - until it returns @Nothing@. @reread@ is of particular use rendering @io-streams@ - input streams as byte streams in the present sense - -> Q.reread Streams.read :: InputStream S.ByteString -> Q.ByteString IO () -> Q.reread (liftIO . Streams.read) :: MonadIO m => InputStream S.ByteString -> Q.ByteString m () - -The other direction here is - -> Streams.unfoldM Q.unconsChunk :: Q.ByteString IO r -> IO (InputStream S.ByteString) - - -} -reread :: Monad m => (s -> m (Maybe S.ByteString)) -> s -> ByteString m () -reread step s = loop where - loop = Go $ do - m <- step s - case m of - Nothing -> return (Empty ()) - Just a -> return (Chunk a loop) -{-# INLINEABLE reread #-} - -{-| Make the information in a bytestring available to more than one eliminating fold, e.g. - ->>> Q.count 'l' $ Q.count 'o' $ Q.copy $ "hello\nworld" -3 :> (2 :> ()) - ->>> Q.length $ Q.count 'l' $ Q.count 'o' $ Q.copy $ Q.copy "hello\nworld" -11 :> (3 :> (2 :> ())) - ->>> runResourceT $ Q.writeFile "hello2.txt" $ Q.writeFile "hello1.txt" $ Q.copy $ "hello\nworld\n" ->>> :! cat hello2.txt -hello -world ->>> :! cat hello1.txt -hello -world - - This sort of manipulation could as well be acheived by combining folds - using - @Control.Foldl@ for example. But any sort of manipulation can be involved in - the fold. Here are a couple of trivial complications involving splitting by lines: - ->>> let doubleLines = Q.unlines . maps (<* Q.chunk "\n" ) . Q.lines ->>> let emphasize = Q.unlines . maps (<* Q.chunk "!" ) . Q.lines ->>> runResourceT $ Q.writeFile "hello2.txt" $ emphasize $ Q.writeFile "hello1.txt" $ doubleLines $ Q.copy $ "hello\nworld" ->>> :! cat hello2.txt -hello! -world! ->>> :! cat hello1.txt -hello - -world - - As with the parallel operations in @Streaming.Prelude@, we have - -> Q.effects . Q.copy = id -> hoist Q.effects . Q.copy = id - - The duplication does not by itself involve the copying of bytestring chunks; - it just makes two references to each chunk as it arises. This does, however - double the number of constructors associated with each chunk. - --} - -copy - :: Monad m => - ByteString m r -> ByteString (ByteString m) r -copy = loop where - loop str = case str of - Empty r -> Empty r - Go m -> Go (liftM loop (lift m)) - Chunk bs rest -> Chunk bs (Go (Chunk bs (Empty (loop rest)))) - -{-# INLINABLE copy #-} diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,121 +1,105 @@ -# bytestring-streaming - -This package depends on the [`streaming` library](https://github.com/michaelt/streaming) - - - copy 200M file divide it on lines, - adding '!' to each - - lazy 0m0.813s 0m8.597s - streaming 0m0.783s 0m9.664s - pipes 0m0.771s 0m49.176s - conduit 0m1.068s 2m25.437s - -This library is modeled as far as possible on the internal structure of -`Data.ByteString.Lazy`. There are two changes: a chunk may be delayed -by a monadic step, and the sucession of steps has a 'return' value: - - data ByteString m r = - Empty r - | Chunk {-#UNPACK #-} !S.ByteString (ByteString m r) - | Go (m (ByteString m r )) - -unlike - - data ByteString = - Empty - | Chunk {-#UNPACK #-} !S.ByteString ByteString - -That's it. +# streaming-bytestring ------ +[![Build](https://github.com/haskell-streaming/streaming-bytestring/workflows/Tests/badge.svg)](https://github.com/haskell-streaming/streaming-bytestring/actions) +[![Build Status](https://travis-ci.org/haskell-streaming/streaming-bytestring.svg?branch=master)](https://travis-ci.org/haskell-streaming/streaming-bytestring) +[![Hackage](https://img.shields.io/hackage/v/streaming-bytestring.svg)](https://hackage.haskell.org/package/streaming-bytestring) -Another module is planned that would correspond more closely to -`Pipes.Bytestring` than to `Data.ByteString.Lazy`. -`Producer ByteString m r` as it is treated in `pipes-bytestring` as -the `ByteString m r` type is here. The result is much faster, at least -with preliminary tests. The modules integrating `attoparsec` and `aeson` -are simple replicas of k0001's `pipes-attoparsec` and `pipes-aeson`. -Also included is a replica of `pipes-http`. +This library enables fast and safe streaming of byte data, in either `Word8` or +`Char` form. It is a core addition to the [`streaming` +ecosystem](https://github.com/haskell-streaming/) and avoids the usual pitfalls +of combinbing lazy `ByteString`s with lazy `IO`. -It is possible that `streaming-bytestring` is conceptually clearer than -`pipes-bytestring` as well - and clearer than the approach taken by -`conduit` and `io-streams`. All of these are forced to integrate the -conception of *an amorphous succession of bytes that may be chunked anywhere* - -the direct result of, say, `fromHandle`, `sourceFile` and -the like - and a succession of 'semantically' distinct bytestrings -of interest under a single concept. +This library is used by +[`streaming-attoparsec`](http://hackage.haskell.org/package/streaming-attoparsec) +to enable vanilla [Attoparsec](http://hackage.haskell.org/package/attoparsec) +parsers to work with `streaming` "for free". ----- +## Usage -Strange as it may seem, it is arguable that the general `Producer`, -`Source`, and `InputStream` concepts from these libraries ought not -to hold `ByteString`s *except* as conceptually separate units, e.g. -the lines of a document taken as strict bytestrings, where that is -legitimate. An `InputStream ByteString` is like an `InputStream Int`; -a `Conduit.Source m ByteString` has the same type as a `Source m Int`; -a `Pipes.Producer ByteString m r` has the same type as a `Producer Int m r`. -These types are suited to the general stream transformations these -libraries make possible. +### Importing and Types -We can see the strangeness in the `io-streams` `lines` +Modules from this library are intended to be imported qualified. To avoid +conflicts with both the `bytestring` library and `streaming`, we recommended `Q` +as the qualified name: - lines :: InputStream ByteString -> IO (InputStream ByteString) +```haskell +import qualified Streaming.ByteString.Char8 as Q +``` -and the `conduit` `linesUnboundedAscii` +Like the `bytestring` library, leaving off the `Char8` will expose an API based +on `Word8`. Following the philosophy of `streaming` that "the best API is the +one you already know", these APIs are based closely on `bytestring`. The core +type is `ByteStream m r`, where: - linesUnboundedAscii :: (Monad m) => Conduit ByteString m ByteString - -(specializing slightly). In either case, what enters on the left will -be a succession of anyhow-chunked bytes; what exits on the right will -be a succession of significant individual things of type `ByteString`. +- `m`: The Monad used to fetch further chunks from the "source", usually `IO`. +- `r`: The final return value after all streaming has concluded, usually `()` as in `streaming`. -What we find in `IOStreams.lines` and -`linesUnlimitedAscii` are comparable to what we would have if `bytestring` -defined +You can imagine this type to represent an infinitely-sized collection of bytes, +although internally it references a **strict** `ByteString` no larger than 32kb, +followed by monadic instructions to fetch further chunks. - lines :: L.ByteString -> [S.ByteString] - -or more absurdly +### Examples - lines :: L.ByteString -> L.ByteString +#### File Input -and exposed methods for inspecting the hitherto secret chunks contained -in lazy bytestrings. +To open a file of any size and count its characters: -The model employed by the present package is a little different. First, -the primitive `lines` concept is just +```haskell +import Control.Monad.Trans.Resource (runResourceT) +import qualified Streaming.Streaming.Char8 as Q - lines :: ByteString m r -> Stream (ByteString m) m r +-- | Represents a potentially-infinite stream of `Char`. +chars :: ByteStream IO () +chars = Q.readFile "huge-file.txt" -as in `pipes-bytestring`; this corresponds precisely to +main :: IO () +main = runResourceT (Q.length_ chars) >>= print +``` - lines :: ByteString -> [ByteString] +Note that file IO specifically requires the +[`resourcet`](http://hackage.haskell.org/package/resourcet) library. -as it appears in `Data.ByteString.Lazy` -- the elements of the list (stream) are -themselves lazy bytestrings. +#### Line splitting and `Stream` interop -But `pipes-bytestring` attempts to *mean* by `Producer ByteString m r` -what we express by `ByteString m r` - the undifferentiated byte stream. -But (we are provisionally suggesting) that isn't what `Producer ByteString m r` -means, and this is part of the reason why `pipes-bytestring` is difficult -for people to grasp. The user frequently proposes to inspect and work -with individual lines with Pipes themselves and thus needs +In the example above you may have noticed a lack of `Of` that we usually see +with `Stream`. Our old friend `lines` hints at this too: - produceLines :: Producer ByteString m r -> Producer ByteString m r - produceLines = folds B.concat B.empty id . view Pipes.ByteString.lines - -Here we would instead write a +```haskell +lines :: Monad m => ByteStream m r -> Stream (ByteStream m) m r +``` - produceLines :: ByteString m r -> Stream (Of ByteString) m r +A stream-of-streams, yet no `Of` here either. The return type can't naively be +`Stream (Of ByteString) m r`, since the first line break might be at the very +end of a large file. Forcing that into a single strict `ByteString` would crash +your program. -which is transparently related to the type of lines itself +To count the number of lines whose first letter is `i`: - lines :: ByteString m r -> Stream (ByteString m) m r +```haskell +countOfI :: IO Int +countOfI = runResourceT + . S.length_ -- IO Int + . S.filter (== 'i') -- Stream (Of Char) IO () + . S.concat -- Stream (Of Char) IO () + . S.mapped Q.head -- Stream (Of (Maybe Char)) IO () + . Q.lines -- Stream (ByteStream IO) IO () + $ Q.readFile "huge-file.txt" -- ByteStream IO () +``` -The distinctive type of `produceLines` clearly express the transition -from the world of amorphously chunked bytestreams to the world of -significant individual values, in this case individual strict bytestrings. +Critically, there are several functions which when combined with `mapped` can +bring us back into `Of`-land: +```haskell +head :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) +last :: Monad m => ByteStream m r -> m (Of (Maybe Char) r) +null :: Monad m => ByteStream m r -> m (Of Bool) r) +count :: Monad m => ByteStream m r -> m (Of Int) r) +toLazy :: Monad m => ByteStream m r -> m (Of ByteString r) -- Be careful with this. +toStrict :: Monad m => ByteStream m r -> m (Of ByteString r) -- Be even *more* careful with this. +``` +When moving in the opposite direction API-wise, consider: +```haskell +fromChunks :: Stream (Of ByteString) m r -> ByteStream m r +``` diff --git a/lib/Data/ByteString/Streaming.hs b/lib/Data/ByteString/Streaming.hs new file mode 100644 --- /dev/null +++ b/lib/Data/ByteString/Streaming.hs @@ -0,0 +1,7 @@ +-- | A simple module reexport to aid back-compatibility. Please use the new +-- module. +module Data.ByteString.Streaming + {-# DEPRECATED "Use Streaming.ByteString instead." #-} + ( module Streaming.ByteString ) where + +import Streaming.ByteString diff --git a/lib/Data/ByteString/Streaming/Char8.hs b/lib/Data/ByteString/Streaming/Char8.hs new file mode 100644 --- /dev/null +++ b/lib/Data/ByteString/Streaming/Char8.hs @@ -0,0 +1,7 @@ +-- | A simple module reexport to aid back-compatibility. Please use the new +-- module. +module Data.ByteString.Streaming.Char8 + {-# DEPRECATED "Use Streaming.ByteString.Char8 instead." #-} + ( module Streaming.ByteString.Char8 ) where + +import Streaming.ByteString.Char8 diff --git a/lib/Data/ByteString/Streaming/Internal.hs b/lib/Data/ByteString/Streaming/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Data/ByteString/Streaming/Internal.hs @@ -0,0 +1,7 @@ +-- | A simple module reexport to aid back-compatibility. Please use the new +-- module. +module Data.ByteString.Streaming.Internal + {-# DEPRECATED "Use Streaming.ByteString.Internal instead." #-} + ( module Streaming.ByteString.Internal ) where + +import Streaming.ByteString.Internal diff --git a/lib/Streaming/ByteString.hs b/lib/Streaming/ByteString.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/ByteString.hs @@ -0,0 +1,1322 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} + +-- | +-- Module : Streaming.ByteString +-- Copyright : (c) Don Stewart 2006 +-- (c) Duncan Coutts 2006-2011 +-- (c) Michael Thompson 2015 +-- License : BSD-style +-- +-- Maintainer : what_is_it_to_do_anything@yahoo.com +-- Stability : experimental +-- Portability : portable +-- +-- See the simple examples of use +-- and the @ghci@ examples especially in "Streaming.ByteString.Char8". +-- We begin with a slight modification of the documentation to "Data.ByteString.Lazy": +-- +-- A time and space-efficient implementation of effectful byte streams using a +-- stream of packed 'Word8' arrays, suitable for high performance use, both in +-- terms of large data quantities, or high speed requirements. Streaming +-- ByteStrings are encoded as streams of strict chunks of bytes. +-- +-- A key feature of streaming ByteStrings is the means to manipulate large or +-- unbounded streams of data without requiring the entire sequence to be +-- resident in memory. To take advantage of this you have to write your +-- functions in a streaming style, e.g. classic pipeline composition. The +-- default I\/O chunk size is 32k, which should be good in most circumstances. +-- +-- Some operations, such as 'concat', 'append', and 'cons', have better +-- complexity than their "Data.ByteString" equivalents, due to optimisations +-- resulting from the list spine structure. For other operations streaming, like +-- lazy, ByteStrings are usually within a few percent of strict ones. +-- +-- This module is intended to be imported @qualified@, to avoid name clashes +-- with "Prelude" functions. eg. +-- +-- > import qualified Streaming.ByteString as Q +-- +-- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use +-- 'Data.Array.Unboxed.UArray' by Simon Marlow. Rewritten to support slices and +-- use 'Foreign.ForeignPtr.ForeignPtr' by David Roundy. Rewritten again and +-- extended by Don Stewart and Duncan Coutts. Lazy variant by Duncan Coutts and +-- Don Stewart. Streaming variant by Michael Thompson, following the ideas of +-- Gabriel Gonzales' pipes-bytestring. +module Streaming.ByteString + ( -- * The @ByteStream@ type + ByteStream + , ByteString + + -- * Introducing and eliminating 'ByteStream's + , empty -- empty :: ByteStream m () + , singleton -- singleton :: Monad m => Word8 -> ByteStream m () + , pack -- pack :: Monad m => Stream (Of Word8) m r -> ByteStream m r + , unpack -- unpack :: Monad m => ByteStream m r -> Stream (Of Word8) m r + , fromLazy -- fromLazy :: Monad m => ByteString -> ByteStream m () + , toLazy -- toLazy :: Monad m => ByteStream m () -> m ByteString + , toLazy_ -- toLazy' :: Monad m => ByteStream m () -> m (Of ByteString r) + , fromChunks -- fromChunks :: Monad m => Stream (Of ByteString) m r -> ByteStream m r + , toChunks -- toChunks :: Monad m => ByteStream m r -> Stream (Of ByteString) m r + , fromStrict -- fromStrict :: ByteString -> ByteStream m () + , toStrict -- toStrict :: Monad m => ByteStream m () -> m ByteString + , toStrict_ -- toStrict_ :: Monad m => ByteStream m r -> m (Of ByteString r) + , effects + , copy + , drained + , mwrap + , distribute -- distribute :: ByteStream (t m) a -> t (ByteStream m) a + + -- * Transforming ByteStreams + , map -- map :: Monad m => (Word8 -> Word8) -> ByteStream m r -> ByteStream m r + , intercalate -- intercalate :: Monad m => ByteStream m () -> Stream (ByteStream m) m r -> ByteStream m r + , intersperse -- intersperse :: Monad m => Word8 -> ByteStream m r -> ByteStream m r + + -- * Basic interface + , cons -- cons :: Monad m => Word8 -> ByteStream m r -> ByteStream m r + , cons' -- cons' :: Word8 -> ByteStream m r -> ByteStream m r + , snoc + , append -- append :: Monad m => ByteStream m r -> ByteStream m s -> ByteStream m s + , filter -- filter :: (Word8 -> Bool) -> ByteStream m r -> ByteStream m r + , uncons -- uncons :: Monad m => ByteStream m r -> m (Either r (Word8, ByteStream m r)) + , nextByte -- nextByte :: Monad m => ByteStream m r -> m (Either r (Word8, ByteStream m r)) + , denull + + -- * Substrings + -- ** Breaking strings + , break -- break :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) + , drop -- drop :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m r + , dropWhile + , group -- group :: Monad m => ByteStream m r -> Stream (ByteStream m) m r + , groupBy + , span -- span :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) + , splitAt -- splitAt :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m (ByteStream m r) + , splitWith -- splitWith :: Monad m => (Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r + , take -- take :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m () + , takeWhile -- takeWhile :: (Word8 -> Bool) -> ByteStream m r -> ByteStream m () + + -- ** Breaking into many substrings + , split -- split :: Monad m => Word8 -> ByteStream m r -> Stream (ByteStream m) m r + + -- ** Special folds + , concat -- concat :: Monad m => Stream (ByteStream m) m r -> ByteStream m r + + -- * Builders + , toStreamingByteStringWith + , toStreamingByteString + , toBuilder + , concatBuilders + + -- * Building ByteStreams + -- ** Infinite ByteStreams + , repeat -- repeat :: Word8 -> ByteStream m r + , iterate -- iterate :: (Word8 -> Word8) -> Word8 -> ByteStream m r + , cycle -- cycle :: Monad m => ByteStream m r -> ByteStream m s + + -- ** Unfolding ByteStreams + , unfoldM -- unfoldr :: (a -> m (Maybe (Word8, a))) -> m a -> ByteStream m () + , unfoldr -- unfold :: (a -> Either r (Word8, a)) -> a -> ByteStream m r + , reread + + -- * Folds, including support for `Control.Foldl` + , foldr -- foldr :: Monad m => (Word8 -> a -> a) -> a -> ByteStream m () -> m a + , fold -- fold :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m () -> m b + , fold_ -- fold' :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m r -> m (b, r) + , head + , head_ + , last + , last_ + , length + , length_ + , null + , null_ + , nulls + , testNull + , count + , count_ + + -- * I\/O with 'ByteStream's + -- ** Standard input and output + , getContents -- getContents :: ByteStream IO () + , stdin -- stdin :: ByteStream IO () + , stdout -- stdout :: ByteStream IO r -> IO r + , interact -- interact :: (ByteStream IO () -> ByteStream IO r) -> IO r + + -- ** Files + , readFile -- readFile :: FilePath -> ByteStream IO () + , writeFile -- writeFile :: FilePath -> ByteStream IO r -> IO r + , appendFile -- appendFile :: FilePath -> ByteStream IO r -> IO r + + -- ** I\/O with Handles + , fromHandle -- fromHandle :: Handle -> ByteStream IO () + , toHandle -- toHandle :: Handle -> ByteStream IO r -> IO r + , hGet -- hGet :: Handle -> Int -> ByteStream IO () + , hGetContents -- hGetContents :: Handle -> ByteStream IO () + , hGetContentsN -- hGetContentsN :: Int -> Handle -> ByteStream IO () + , hGetN -- hGetN :: Int -> Handle -> Int -> ByteStream IO () + , hGetNonBlocking -- hGetNonBlocking :: Handle -> Int -> ByteStream IO () + , hGetNonBlockingN -- hGetNonBlockingN :: Int -> Handle -> Int -> ByteStream IO () + , hPut -- hPut :: Handle -> ByteStream IO r -> IO r + -- , hPutNonBlocking -- hPutNonBlocking :: Handle -> ByteStream IO r -> ByteStream IO r + -- * Etc. + , zipWithStream -- zipWithStream :: Monad m => (forall x. a -> ByteStream m x -> ByteStream m x) -> [a] -> Stream (ByteStream m) m r -> Stream (ByteStream m) m r + + -- * Simple chunkwise operations + , unconsChunk + , nextChunk + , chunk + , foldrChunks + , foldlChunks + , chunkFold + , chunkFoldM + , chunkMap + , chunkMapM + , chunkMapM_ + ) 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, unzip, writeFile, zip, zipWith) + +import qualified Data.ByteString as P (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Builder.Internal hiding + (append, defaultChunkSize, empty, hPut) +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy.Internal as BI +import qualified Data.ByteString.Unsafe as B + +import Streaming hiding (concats, distribute, unfold) +import Streaming.ByteString.Internal +import Streaming.Internal (Stream(..)) +import qualified Streaming.Prelude as SP + +import Control.Monad (forever) +import Control.Monad.Trans.Resource +import Data.Int (Int64) +import qualified Data.List as L +import Data.Word (Word8) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr +import Foreign.Storable +import System.IO (Handle, IOMode(..), hClose, openBinaryFile) +import qualified System.IO as IO (stdin, stdout) +import System.IO.Error (illegalOperationErrorType, mkIOError) + +-- | /O(n)/ Concatenate a stream of byte streams. +concat :: Monad m => Stream (ByteStream m) m r -> ByteStream m r +concat x = destroy x join Go Empty +{-# INLINE concat #-} + +-- | Given a byte stream on a transformed monad, make it possible to \'run\' +-- transformer. +distribute + :: (Monad m, MonadTrans t, MFunctor t, Monad (t m), Monad (t (ByteStream m))) + => ByteStream (t m) a -> t (ByteStream m) a +distribute ls = dematerialize ls + return + (\bs x -> join $ lift $ Chunk bs (Empty x) ) + (join . hoist (Go . fmap Empty)) +{-# INLINE distribute #-} + +-- | Perform the effects contained in an effectful bytestring, ignoring the bytes. +effects :: Monad m => ByteStream m r -> m r +effects bs = case bs of + Empty r -> return r + Go m -> m >>= effects + Chunk _ rest -> effects rest +{-# INLINABLE effects #-} + +-- | Perform the effects contained in the second in an effectful pair of +-- bytestrings, ignoring the bytes. It would typically be used at the type +-- +-- > ByteStream m (ByteStream m r) -> ByteStream m r +drained :: (Monad m, MonadTrans t, Monad (t m)) => t m (ByteStream m r) -> t m r +drained t = t >>= lift . effects + +-- ----------------------------------------------------------------------------- +-- Introducing and eliminating 'ByteStream's + +-- | /O(1)/ The empty 'ByteStream' -- i.e. @return ()@ Note that @ByteStream m w@ is +-- generally a monoid for monoidal values of @w@, like @()@. +empty :: ByteStream m () +empty = Empty () +{-# INLINE empty #-} + +-- | /O(1)/ Yield a 'Word8' as a minimal 'ByteStream'. +singleton :: Monad m => Word8 -> ByteStream m () +singleton w = Chunk (B.singleton w) (Empty ()) +{-# INLINE singleton #-} + +-- | /O(n)/ Convert a monadic stream of individual 'Word8's into a packed byte stream. +pack :: Monad m => Stream (Of Word8) m r -> ByteStream m r +pack = packBytes +{-# INLINE pack #-} + +-- | /O(n)/ Converts a packed byte stream into a stream of individual bytes. +unpack :: Monad m => ByteStream m r -> Stream (Of Word8) m r +unpack = unpackBytes + +-- | /O(c)/ Convert a monadic stream of individual strict 'ByteString' chunks +-- into a byte stream. +fromChunks :: Monad m => Stream (Of P.ByteString) m r -> ByteStream m r +fromChunks cs = destroy cs (\(bs :> rest) -> Chunk bs rest) Go return +{-# INLINE fromChunks #-} + +-- | /O(c)/ Convert a byte stream into a stream of individual strict +-- bytestrings. This of course exposes the internal chunk structure. +toChunks :: Monad m => ByteStream m r -> Stream (Of P.ByteString) m r +toChunks bs = dematerialize bs return (\b mx -> Step (b:> mx)) Effect +{-# INLINE toChunks #-} + +-- | /O(1)/ Yield a strict 'ByteString' chunk. +fromStrict :: P.ByteString -> ByteStream m () +fromStrict bs | B.null bs = Empty () + | otherwise = Chunk bs (Empty ()) +{-# INLINE fromStrict #-} + +-- | /O(n)/ Convert a byte stream into a single strict 'ByteString'. +-- +-- Note that this is an /expensive/ operation that forces the whole monadic +-- ByteString into memory and then copies all the data. If possible, try to +-- avoid converting back and forth between streaming and strict bytestrings. +toStrict_ :: Monad m => ByteStream m () -> m B.ByteString +toStrict_ = fmap B.concat . SP.toList_ . toChunks +{-# INLINE toStrict_ #-} + +-- | /O(n)/ Convert a monadic byte stream into a single strict 'ByteString', +-- retaining the return value of the original pair. This operation is for use +-- with 'mapped'. +-- +-- > mapped R.toStrict :: Monad m => Stream (ByteStream m) m r -> Stream (Of ByteString) m r +-- +-- It is subject to all the objections one makes to Data.ByteString.Lazy +-- 'toStrict'; all of these are devastating. +toStrict :: Monad m => ByteStream m r -> m (Of B.ByteString r) +toStrict bs = do + (bss :> r) <- SP.toList (toChunks bs) + return (B.concat bss :> r) +{-# INLINE toStrict #-} + +-- |/O(c)/ Transmute a pseudo-pure lazy bytestring to its representation as a +-- monadic stream of chunks. +-- +-- >>> Q.putStrLn $ Q.fromLazy "hi" +-- hi +-- >>> Q.fromLazy "hi" +-- Chunk "hi" (Empty (())) -- note: a 'show' instance works in the identity monad +-- >>> Q.fromLazy $ BL.fromChunks ["here", "are", "some", "chunks"] +-- Chunk "here" (Chunk "are" (Chunk "some" (Chunk "chunks" (Empty (()))))) +fromLazy :: Monad m => BI.ByteString -> ByteStream m () +fromLazy = BI.foldrChunks Chunk (Empty ()) +{-# INLINE fromLazy #-} + +-- | /O(n)/ Convert an effectful byte stream into a single lazy 'ByteStream' +-- with the same internal chunk structure. See `toLazy` which preserve +-- connectedness by keeping the return value of the effectful bytestring. +toLazy_ :: Monad m => ByteStream m r -> m BI.ByteString +toLazy_ bs = dematerialize bs (\_ -> return BI.Empty) (fmap . BI.Chunk) join +{-# INLINE toLazy_ #-} + +-- | /O(n)/ Convert an effectful byte stream into a single lazy 'ByteString' +-- with the same internal chunk structure, retaining the original return value. +-- +-- This is the canonical way of breaking streaming (`toStrict` and the like are +-- far more demonic). Essentially one is dividing the interleaved layers of +-- effects and bytes into one immense layer of effects, followed by the memory +-- of the succession of bytes. +-- +-- Because one preserves the return value, `toLazy` is a suitable argument for +-- 'Streaming.mapped': +-- +-- > S.mapped Q.toLazy :: Stream (ByteStream m) m r -> Stream (Of L.ByteString) m r +-- +-- >>> Q.toLazy "hello" +-- "hello" :> () +-- >>> S.toListM $ traverses Q.toLazy $ Q.lines "one\ntwo\nthree\nfour\nfive\n" +-- ["one","two","three","four","five",""] -- [L.ByteString] +toLazy :: Monad m => ByteStream m r -> m (Of BI.ByteString r) +toLazy bs0 = dematerialize bs0 + (\r -> return (BI.Empty :> r)) + (\b mx -> do + (bs :> x) <- mx + return $ BI.Chunk b bs :> x + ) + join +{-# INLINE toLazy #-} + +-- --------------------------------------------------------------------- +-- Basic interface +-- + +-- | Test whether a `ByteStream` is empty, collecting its return value; to reach +-- the return value, this operation must check the whole length of the string. +-- +-- >>> Q.null "one\ntwo\three\nfour\nfive\n" +-- False :> () +-- >>> Q.null "" +-- True :> () +-- >>> S.print $ mapped R.null $ Q.lines "yours,\nMeredith" +-- False +-- False +-- +-- Suitable for use with `SP.mapped`: +-- +-- @ +-- S.mapped Q.null :: Streaming (ByteStream m) m r -> Stream (Of Bool) m r +-- @ +null :: Monad m => ByteStream m r -> m (Of Bool r) +null (Empty r) = return (True :> r) +null (Go m) = m >>= null +null (Chunk bs rest) = if B.null bs + then null rest + else do + r <- SP.effects (toChunks rest) + return (False :> r) +{-# INLINABLE null #-} + +-- | /O(1)/ Test whether a `ByteStream` is empty. The value is of course in the +-- monad of the effects. +-- +-- >>> Q.null "one\ntwo\three\nfour\nfive\n" +-- False +-- >>> Q.null $ Q.take 0 Q.stdin +-- True +-- >>> :t Q.null $ Q.take 0 Q.stdin +-- Q.null $ Q.take 0 Q.stdin :: MonadIO m => m Bool +null_ :: Monad m => ByteStream m r -> m Bool +null_ (Empty _) = return True +null_ (Go m) = m >>= null_ +null_ (Chunk bs rest) = if B.null bs + then null_ rest + else return False +{-# INLINABLE null_ #-} + +-- | Similar to `null`, but yields the remainder of the `ByteStream` stream when +-- an answer has been determined. +testNull :: Monad m => ByteStream m r -> m (Of Bool (ByteStream m r)) +testNull (Empty r) = return (True :> Empty r) +testNull (Go m) = m >>= testNull +testNull p@(Chunk bs rest) = if B.null bs + then testNull rest + else return (False :> p) +{-# INLINABLE testNull #-} + +-- | Remove empty ByteStrings from a stream of bytestrings. +denull :: Monad m => Stream (ByteStream m) m r -> Stream (ByteStream m) m r +denull = hoist (run . maps effects) . separate . mapped nulls +{-# INLINE denull #-} + +{-| /O1/ Distinguish empty from non-empty lines, while maintaining streaming; + the empty ByteStrings are on the right + +>>> nulls :: ByteStream m r -> m (Sum (ByteStream m) (ByteStream m) r) + + There are many ways to remove null bytestrings from a + @Stream (ByteStream m) m r@ (besides using @denull@). If we pass next to + +>>> mapped nulls bs :: Stream (Sum (ByteStream m) (ByteStream m)) m r + + then can then apply @Streaming.separate@ to get + +>>> separate (mapped nulls bs) :: Stream (ByteStream m) (Stream (ByteStream m) m) r + + The inner monad is now made of the empty bytestrings; we act on this + with @hoist@ , considering that + +>>> :t Q.effects . Q.concat +Q.effects . Q.concat + :: Monad m => Stream (Q.ByteStream m) m r -> m r + + we have + +>>> hoist (Q.effects . Q.concat) . separate . mapped Q.nulls + :: Monad n => Stream (Q.ByteStream n) n b -> Stream (Q.ByteStream n) n b +-} +nulls :: Monad m => ByteStream m r -> m (Sum (ByteStream m) (ByteStream m) r) +nulls (Empty r) = return (InR (return r)) +nulls (Go m) = m >>= nulls +nulls (Chunk bs rest) = if B.null bs + then nulls rest + else return (InL (Chunk bs rest)) +{-# INLINABLE nulls #-} + +-- | Like `length`, report the length in bytes of the `ByteStream` by running +-- through its contents. Since the return value is in the effect @m@, this is +-- one way to "get out" of the stream. +length_ :: Monad m => ByteStream m r -> m Int +length_ = fmap (\(n:> _) -> n) . foldlChunks (\n c -> n + fromIntegral (B.length c)) 0 +{-# INLINE length_ #-} + +-- | /O(n\/c)/ 'length' returns the length of a byte stream as an 'Int' together +-- with the return value. This makes various maps possible. +-- +-- >>> Q.length "one\ntwo\three\nfour\nfive\n" +-- 23 :> () +-- >>> S.print $ S.take 3 $ mapped Q.length $ Q.lines "one\ntwo\three\nfour\nfive\n" +-- 3 +-- 8 +-- 4 +length :: Monad m => ByteStream m r -> m (Of Int r) +length = foldlChunks (\n c -> n + fromIntegral (B.length c)) 0 +{-# INLINE length #-} + +-- | /O(1)/ 'cons' is analogous to @(:)@ for lists. +cons :: Monad m => Word8 -> ByteStream m r -> ByteStream m r +cons c cs = Chunk (B.singleton c) cs +{-# INLINE cons #-} + +-- | /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 byte streams. +cons' :: Word8 -> ByteStream m r -> ByteStream m r +cons' w (Chunk c cs) | B.length c < 16 = Chunk (B.cons w c) cs +cons' w cs = Chunk (B.singleton w) cs +{-# INLINE cons' #-} + +-- | /O(n\/c)/ Append a byte to the end of a 'ByteStream'. +snoc :: Monad m => ByteStream m r -> Word8 -> ByteStream m r +snoc cs w = do -- cs <* singleton w + r <- cs + singleton w + return r +{-# INLINE snoc #-} + +-- | /O(1)/ Extract the first element of a 'ByteStream', which must be non-empty. +head_ :: Monad m => ByteStream m r -> m Word8 +head_ (Empty _) = error "head" +head_ (Chunk c bs) = if B.null c + then head_ bs + else return $ B.unsafeHead c +head_ (Go m) = m >>= head_ +{-# INLINABLE head_ #-} + +-- | /O(c)/ Extract the first element of a 'ByteStream', if there is one. +-- Suitable for use with `SP.mapped`: +-- +-- @ +-- S.mapped Q.head :: Stream (Q.ByteStream m) m r -> Stream (Of (Maybe Word8)) m r +-- @ +head :: Monad m => ByteStream m r -> m (Of (Maybe Word8) r) +head (Empty r) = return (Nothing :> r) +head (Chunk c rest) = case B.uncons c of + Nothing -> head rest + Just (w,_) -> do + r <- SP.effects $ toChunks rest + return $! Just w :> r +head (Go m) = m >>= head +{-# INLINABLE head #-} + +-- | /O(1)/ Extract the head and tail of a 'ByteStream', or 'Nothing' if it is +-- empty. +uncons :: Monad m => ByteStream m r -> m (Maybe (Word8, ByteStream m r)) +uncons (Empty _) = return Nothing +uncons (Chunk c cs) + = return $ Just (B.unsafeHead c + , if B.length c == 1 + then cs + else Chunk (B.unsafeTail c) cs ) +uncons (Go m) = m >>= uncons +{-# INLINABLE uncons #-} + +-- | /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. +nextByte :: Monad m => ByteStream m r -> m (Either r (Word8, ByteStream m r)) +nextByte (Empty r) = return (Left r) +nextByte (Chunk c cs) + = if B.null c + then nextByte cs + else return $ Right (B.unsafeHead c + , if B.length c == 1 + then cs + else Chunk (B.unsafeTail c) cs ) +nextByte (Go m) = m >>= nextByte +{-# INLINABLE nextByte #-} + +-- | Like `uncons`, but yields the entire first `B.ByteString` chunk that the +-- stream is holding onto. If there wasn't one, it tries to fetch it. +unconsChunk :: Monad m => ByteStream m r -> m (Maybe (B.ByteString, ByteStream m r)) +unconsChunk (Empty _) = return Nothing +unconsChunk (Chunk c cs) = return (Just (c,cs)) +unconsChunk (Go m) = m >>= unconsChunk +{-# INLINABLE unconsChunk #-} + +-- | Similar to `unconsChunk`, but yields the final @r@ return value when there +-- is no subsequent chunk. +nextChunk :: Monad m => ByteStream m r -> m (Either r (B.ByteString, ByteStream m r)) +nextChunk (Empty r) = return (Left r) +nextChunk (Go m) = m >>= nextChunk +nextChunk (Chunk c cs) + | B.null c = nextChunk cs + | otherwise = return (Right (c,cs)) +{-# INLINABLE nextChunk #-} + +-- | /O(n\/c)/ Extract the last element of a 'ByteStream', which must be finite +-- and non-empty. +last_ :: Monad m => ByteStream m r -> m Word8 +last_ (Empty _) = error "Streaming.ByteString.last: empty string" +last_ (Go m) = m >>= last_ +last_ (Chunk c0 cs0) = go c0 cs0 + where + go c (Empty _) = if B.null c + then error "Streaming.ByteString.last: empty string" + else return $ unsafeLast c + go _ (Chunk c cs) = go c cs + go x (Go m) = m >>= go x +{-# INLINABLE 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 Word8)) m r +-- @ +last :: Monad m => ByteStream m r -> m (Of (Maybe Word8) r) +last (Empty r) = return (Nothing :> r) +last (Go m) = m >>= last +last (Chunk c0 cs0) = go c0 cs0 + where + go c (Empty r) = return (Just (unsafeLast c) :> r) + go _ (Chunk c cs) = go c cs + go x (Go m) = m >>= go x +{-# INLINABLE last #-} + +-- | /O(n\/c)/ Append two `ByteString`s together. +append :: Monad m => ByteStream m r -> ByteStream m s -> ByteStream m s +append xs ys = dematerialize xs (const ys) Chunk Go +{-# INLINE append #-} + +-- --------------------------------------------------------------------- +-- Transformations + +-- | /O(n)/ 'map' @f xs@ is the ByteStream obtained by applying @f@ to each +-- element of @xs@. +map :: Monad m => (Word8 -> Word8) -> ByteStream m r -> ByteStream m r +map f z = dematerialize z Empty (Chunk . B.map f) Go +{-# INLINE map #-} + +-- -- | /O(n)/ 'reverse' @xs@ returns the elements of @xs@ in reverse order. +-- reverse :: ByteString -> ByteString +-- reverse cs0 = rev Empty cs0 +-- where rev a Empty = a +-- rev a (Chunk c cs) = rev (Chunk (B.reverse c) a) cs +-- {-# INLINE reverse #-} + +-- | The 'intersperse' function takes a 'Word8' 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 => Word8 -> ByteStream m r -> ByteStream m r +intersperse _ (Empty r) = Empty r +intersperse w (Go m) = Go (fmap (intersperse w) m) +intersperse w (Chunk c cs) = Chunk (B.intersperse w c) + (dematerialize cs Empty (Chunk . intersperse') Go) + where intersperse' :: P.ByteString -> P.ByteString + intersperse' (B.PS fp o l) = + B.unsafeCreate (2*l) $ \p' -> withForeignPtr fp $ \p -> do + poke p' w + B.c_intersperse (p' `plusPtr` 1) (p `plusPtr` o) (fromIntegral l) w + +{-# INLINABLE intersperse #-} + +-- | 'foldr', applied to a binary operator, a starting value (typically the +-- right-identity of the operator), and a ByteStream, reduces the ByteStream +-- using the binary operator, from right to left. +-- +-- > foldr cons = id +-- +foldr :: Monad m => (Word8 -> a -> a) -> a -> ByteStream m () -> m a +foldr k = foldrChunks (flip (B.foldr k)) +{-# INLINE foldr #-} + +-- | 'fold', applied to a binary operator, a starting value (typically the +-- left-identity of the operator), and a ByteStream, reduces the ByteStream +-- using the binary operator, from left to right. We use the style of the foldl +-- libarary for left folds +fold :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m () -> m b +fold step0 begin finish p0 = loop p0 begin + where + loop p !x = case p of + Chunk bs bss -> loop bss $! B.foldl' step0 x bs + Go m -> m >>= \p' -> loop p' x + Empty _ -> return (finish x) +{-# INLINABLE fold #-} + +-- | 'fold_' keeps the return value of the left-folded bytestring. Useful for +-- simultaneous folds over a segmented bytestream. +fold_ :: Monad m => (x -> Word8 -> x) -> x -> (x -> b) -> ByteStream m r -> m (Of b r) +fold_ step0 begin finish p0 = loop p0 begin + where + loop p !x = case p of + Chunk bs bss -> loop bss $! B.foldl' step0 x bs + Go m -> m >>= \p' -> loop p' x + Empty r -> return (finish x :> r) +{-# INLINABLE fold_ #-} + +-- --------------------------------------------------------------------- +-- Special folds + +-- /O(n)/ Concatenate a list of ByteStreams. +-- concat :: (Monad m) => [ByteStream m ()] -> ByteStream m () +-- concat css0 = to css0 +-- where +-- go css (Empty m') = to css +-- go css (Chunk c cs) = Chunk c (go css cs) +-- go css (Go m) = Go (fmap (go css) m) +-- to [] = Empty () +-- to (cs:css) = go css cs + +-- --------------------------------------------------------------------- +-- 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), ...] + +>>> R.stdout $ R.take 50 $ R.iterate succ 39 +()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY +>>> Q.putStrLn $ Q.take 50 $ Q.iterate succ '\'' +()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXY +-} +iterate :: (Word8 -> Word8) -> Word8 -> ByteStream m r +iterate f = unfoldr (\x -> case f x of !x' -> Right (x', x')) +{-# INLINABLE iterate #-} + +{- | @'repeat' x@ is an infinite ByteStream, with @x@ the value of every + element. + +>>> R.stdout $ R.take 50 $ R.repeat 60 +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +>>> Q.putStrLn $ Q.take 50 $ Q.repeat 'z' +zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz +-} +repeat :: Word8 -> ByteStream m r +repeat w = cs where cs = Chunk (B.replicate BI.smallChunkSize w) cs +{-# INLINABLE repeat #-} + +{- | 'cycle' ties a finite ByteStream into a circular one, or equivalently, + the infinite repetition of the original ByteStream. For an empty bytestring + (like @return 17@) it of course makes an unproductive loop + +>>> Q.putStrLn $ Q.take 7 $ Q.cycle "y\n" +y +y +y +y +-} +cycle :: Monad m => ByteStream m r -> ByteStream m s +cycle = forever +{-# INLINE cycle #-} + +-- | /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 (Word8, a)) -> a -> ByteStream m () +unfoldM f s0 = unfoldChunk 32 s0 + where unfoldChunk n s = + case B.unfoldrN n f s of + (c, Nothing) + | B.null c -> Empty () + | otherwise -> Chunk c (Empty ()) + (c, Just s') -> Chunk c (unfoldChunk (n*2) s') +{-# INLINABLE unfoldM #-} + +-- | Like `unfoldM`, but yields a final @r@ when the `Word8` generation is +-- complete. +unfoldr :: (a -> Either r (Word8, a)) -> a -> ByteStream m r +unfoldr f s0 = unfoldChunk 32 s0 + where unfoldChunk n s = + case unfoldrNE n f s of + (c, Left r) + | B.null c -> Empty r + | otherwise -> Chunk c (Empty r) + (c, Right s') -> Chunk c (unfoldChunk (n*2) s') +{-# INLINABLE unfoldr #-} + +-- --------------------------------------------------------------------- +-- Substrings + +{-| /O(n\/c)/ 'take' @n@, applied to a ByteStream @xs@, returns the prefix + of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. + + Note that in the streaming context this drops the final return value; + 'splitAt' preserves this information, and is sometimes to be preferred. + +>>> Q.putStrLn $ Q.take 8 $ "Is there a God?" >> return True +Is there +>>> Q.putStrLn $ "Is there a God?" >> return True +Is there a God? +True +>>> rest <- Q.putStrLn $ Q.splitAt 8 $ "Is there a God?" >> return True +Is there +>>> Q.effects rest +True +-} +take :: Monad m => Int64 -> ByteStream m r -> ByteStream m () +take i _ | i <= 0 = Empty () +take i cs0 = take' i cs0 + where take' 0 _ = Empty () + take' _ (Empty _) = Empty () + take' n (Chunk c cs) = + if n < fromIntegral (B.length c) + then Chunk (B.take (fromIntegral n) c) (Empty ()) + else Chunk c (take' (n - fromIntegral (B.length c)) cs) + take' n (Go m) = Go (fmap (take' n) m) +{-# INLINABLE take #-} + +{-| /O(n\/c)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ + elements, or @[]@ if @n > 'length' xs@. + +>>> Q.putStrLn $ Q.drop 6 "Wisconsin" +sin +>>> Q.putStrLn $ Q.drop 16 "Wisconsin" + +>>> +-} +drop :: Monad m => Int64 -> ByteStream m r -> ByteStream m r +drop i p | i <= 0 = p +drop i cs0 = drop' i cs0 + where drop' 0 cs = cs + drop' _ (Empty r) = Empty r + drop' n (Chunk c cs) = + if n < fromIntegral (B.length c) + then Chunk (B.drop (fromIntegral n) c) cs + else drop' (n - fromIntegral (B.length c)) cs + drop' n (Go m) = Go (fmap (drop' n) m) +{-# INLINABLE drop #-} + +{-| /O(n\/c)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. + +>>> rest <- Q.putStrLn $ Q.splitAt 3 "therapist is a danger to good hyphenation, as Knuth notes" +the +>>> Q.putStrLn $ Q.splitAt 19 rest +rapist is a danger +-} +splitAt :: Monad m => Int64 -> ByteStream m r -> ByteStream m (ByteStream m r) +splitAt i cs0 | i <= 0 = Empty cs0 +splitAt i cs0 = splitAt' i cs0 + where splitAt' 0 cs = Empty cs + splitAt' _ (Empty r ) = Empty (Empty r) + splitAt' n (Chunk c cs) = + if n < fromIntegral (B.length c) + then Chunk (B.take (fromIntegral n) c) $ + Empty (Chunk (B.drop (fromIntegral n) c) cs) + else Chunk c (splitAt' (n - fromIntegral (B.length c)) cs) + splitAt' n (Go m) = Go (fmap (splitAt' n) m) +{-# INLINABLE splitAt #-} + +-- | '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 => (Word8 -> Bool) -> ByteStream m r -> ByteStream m () +takeWhile f cs0 = takeWhile' cs0 + where + takeWhile' (Empty _) = Empty () + takeWhile' (Go m) = Go $ fmap takeWhile' m + takeWhile' (Chunk c cs) = + case findIndexOrEnd (not . f) c of + 0 -> Empty () + n | n < B.length c -> Chunk (B.take n c) (Empty ()) + | otherwise -> Chunk c (takeWhile' cs) +{-# INLINABLE takeWhile #-} + +-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. +dropWhile :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m r +dropWhile p = drop' where + drop' bs = case bs of + Empty r -> Empty r + Go m -> Go (fmap drop' m) + Chunk c cs -> case findIndexOrEnd (not . p) c of + 0 -> Chunk c cs + n | n < B.length c -> Chunk (B.drop n c) cs + | otherwise -> drop' cs +{-# INLINABLE dropWhile #-} + +-- | 'break' @p@ is equivalent to @'span' ('not' . p)@. +break :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) +break f cs0 = break' cs0 + where break' (Empty r) = Empty (Empty r) + break' (Chunk c cs) = + case findIndexOrEnd f c of + 0 -> Empty (Chunk c cs) + n | n < B.length c -> Chunk (B.take n c) $ + Empty (Chunk (B.drop n c) cs) + | otherwise -> Chunk c (break' cs) + break' (Go m) = Go (fmap break' m) +{-# INLINABLE break #-} + +-- | 'span' @p xs@ breaks the ByteStream into two segments. It is equivalent to +-- @('takeWhile' p xs, 'dropWhile' p xs)@. +span :: Monad m => (Word8 -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) +span p = break (not . p) +{-# INLINE span #-} + +-- | /O(n)/ Splits a 'ByteStream' into components delimited by separators, where +-- the predicate returns True for a separator element. The resulting components +-- do not contain the separators. Two adjacent separators result in an empty +-- component in the output. eg. +-- +-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""] +-- > splitWith (=='a') [] == [] +splitWith :: Monad m => (Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r +splitWith _ (Empty r) = Return r +splitWith p (Go m) = Effect $ fmap (splitWith p) m +splitWith p (Chunk c0 cs0) = comb [] (B.splitWith p c0) cs0 + where +-- comb :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString] +-- comb acc (s:[]) (Empty r) = Step (revChunks (s:acc) (Return r)) + comb acc [s] (Empty r) = Step $ L.foldl' (flip Chunk) + (Empty (Return r)) + (s:acc) + comb acc [s] (Chunk c cs) = comb (s:acc) (B.splitWith p c) cs + comb acc b (Go m) = Effect (fmap (comb acc b) m) + comb acc (s:ss) cs = Step $ L.foldl' (flip Chunk) + (Empty (comb [] ss cs)) + (s:acc) + comb acc [] (Empty r) = Step $ L.foldl' (flip Chunk) + (Empty (Return r)) + acc + comb acc [] (Chunk c cs) = comb acc (B.splitWith p c) cs + -- comb acc (s:ss) cs = Step (revChunks (s:acc) (comb [] ss cs)) + +{-# INLINABLE 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. +split :: Monad m => Word8 -> ByteStream m r -> Stream (ByteStream m) m r +split w = loop + where + loop !x = case x of + Empty r -> Return r + Go m -> Effect $ fmap loop m + Chunk c0 cs0 -> comb [] (B.split w c0) cs0 + comb !acc [] (Empty r) = Step $ revChunks acc (Return r) + comb acc [] (Chunk c cs) = comb acc (B.split w c) cs + comb !acc [s] (Empty r) = Step $ revChunks (s:acc) (Return r) + comb acc [s] (Chunk c cs) = comb (s:acc) (B.split w c) cs + comb acc b (Go m) = Effect (fmap (comb acc b) m) + comb acc (s:ss) cs = Step $ revChunks (s:acc) (comb [] ss cs) +{-# INLINABLE split #-} + +-- | The 'group' function takes a ByteStream and returns a list of ByteStreams +-- such that the concatenation of the result is equal to the argument. Moreover, +-- each sublist in the result contains only equal elements. For example, +-- +-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] +-- +-- It is a special case of 'groupBy', which allows the programmer to supply +-- their own equality test. +group :: Monad m => ByteStream m r -> Stream (ByteStream m) m r +group = go + where + go (Empty r) = Return r + go (Go m) = Effect $ fmap go m + go (Chunk c cs) + | B.length c == 1 = Step $ to [c] (B.unsafeHead c) cs + | otherwise = Step $ to [B.unsafeTake 1 c] (B.unsafeHead c) (Chunk (B.unsafeTail c) cs) + + to acc !_ (Empty r) = revNonEmptyChunks acc (Empty (Return r)) + to acc !w (Go m) = Go $ to acc w <$> m + to acc !w (Chunk c cs) = case findIndexOrEnd (/= w) c of + 0 -> revNonEmptyChunks acc (Empty (go (Chunk c cs))) + n | n == B.length c -> to (B.unsafeTake n c : acc) w cs + | otherwise -> revNonEmptyChunks (B.unsafeTake n c : acc) (Empty (go (Chunk (B.unsafeDrop n c) cs))) +{-# INLINABLE group #-} + +-- | The 'groupBy' function is a generalized version of 'group'. +groupBy :: Monad m => (Word8 -> Word8 -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r +groupBy rel = go + where + -- go :: ByteStream m r -> Stream (ByteStream m) m r + go (Empty r) = Return r + go (Go m) = Effect $ fmap go m + go (Chunk c cs) + | B.length c == 1 = Step $ to [c] (B.unsafeHead c) cs + | otherwise = Step $ to [B.unsafeTake 1 c] (B.unsafeHead c) (Chunk (B.unsafeTail c) cs) + + -- to :: [B.ByteString] -> Word8 -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) + to acc !_ (Empty r) = revNonEmptyChunks acc (Empty (Return r)) + to acc !w (Go m) = Go $ to acc w <$> m + to acc !w (Chunk c cs) = case findIndexOrEnd (not . rel w) c of + 0 -> revNonEmptyChunks acc (Empty (go (Chunk c cs))) + n | n == B.length c -> to (B.unsafeTake n c : acc) w cs + | otherwise -> revNonEmptyChunks (B.unsafeTake n c : acc) (Empty (go (Chunk (B.unsafeDrop n c) cs))) +{-# INLINABLE groupBy #-} + +-- | /O(n)/ The 'intercalate' function takes a 'ByteStream' and a list of +-- 'ByteStream's and concatenates the list after interspersing the first +-- argument between each element of the list. +intercalate :: Monad m => ByteStream m () -> Stream (ByteStream m) m r -> ByteStream m r +intercalate _ (Return r) = Empty r +intercalate s (Effect m) = Go $ fmap (intercalate s) m +intercalate s (Step bs0) = do -- this isn't quite right + ls <- bs0 + s + intercalate s ls + -- where + -- loop (Return r) = Empty r -- concat . (L.intersperse s) + -- loop (Effect m) = Go $ fmap loop m + -- loop (Step bs) = do + -- ls <- bs + -- case ls of + -- Return r -> Empty r -- no '\n' before end, in this case. + -- x -> s >> loop x +{-# INLINABLE intercalate #-} + +-- | Returns the number of times its argument appears in the `ByteStream`. +-- +-- > count = length . elemIndices +count_ :: Monad m => Word8 -> ByteStream m r -> m Int +count_ w = fmap (\(n :> _) -> n) . foldlChunks (\n c -> n + fromIntegral (B.count w c)) 0 +{-# INLINE count_ #-} + +-- | Returns the number of times its argument appears in the `ByteStream`. +-- Suitable for use with `SP.mapped`: +-- +-- @ +-- S.mapped (Q.count 37) :: Stream (Q.ByteStream m) m r -> Stream (Of Int) m r +-- @ +count :: Monad m => Word8 -> ByteStream m r -> m (Of Int r) +count w cs = foldlChunks (\n c -> n + fromIntegral (B.count w c)) 0 cs +{-# INLINE count #-} + +-- --------------------------------------------------------------------- +-- 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 => (Word8 -> Bool) -> ByteStream m r -> ByteStream m r +filter p s = go s + where + go (Empty r ) = Empty r + go (Chunk x xs) = consChunk (B.filter p x) (go xs) + go (Go m) = Go (fmap go m) + -- should inspect for null +{-# INLINABLE filter #-} + +-- --------------------------------------------------------------------- +-- ByteStream IO +-- +-- Rule for when to close: is it expected to read the whole file? +-- If so, close when done. +-- + +-- | Read entire handle contents /lazily/ into a 'ByteStream'. Chunks are read +-- on demand, in at most @k@-sized chunks. It does not block waiting for a whole +-- @k@-sized chunk, so if less than @k@ bytes are available then they will be +-- returned immediately as a smaller chunk. +-- +-- Note: the 'Handle' should be placed in binary mode with +-- 'System.IO.hSetBinaryMode' for 'hGetContentsN' to work correctly. +hGetContentsN :: MonadIO m => Int -> Handle -> ByteStream m () +hGetContentsN k h = loop -- TODO close on exceptions + where + loop = do + c <- liftIO (B.hGetSome h k) + -- only blocks if there is no data available + if B.null c + then Empty () + else Chunk c loop +{-# INLINABLE hGetContentsN #-} -- very effective inline pragma + +-- | Read @n@ bytes into a 'ByteStream', directly from the specified 'Handle', +-- in chunks of size @k@. +hGetN :: MonadIO m => Int -> Handle -> Int -> ByteStream m () +hGetN k h n | n > 0 = readChunks n + where + readChunks !i = Go $ do + c <- liftIO $ B.hGet h (min k i) + case B.length c of + 0 -> return $ Empty () + m -> return $ Chunk c (readChunks (i - m)) +hGetN _ _ 0 = Empty () +hGetN _ h n = liftIO $ illegalBufferSize h "hGet" n -- <--- REPAIR !!! +{-# INLINABLE hGetN #-} + +-- | hGetNonBlockingN is similar to 'hGetContentsN', except that it will never +-- block waiting for data to become available, instead it returns only whatever +-- data is available. Chunks are read on demand, in @k@-sized chunks. +hGetNonBlockingN :: MonadIO m => Int -> Handle -> Int -> ByteStream m () +hGetNonBlockingN k h n | n > 0 = readChunks n + where + readChunks !i = Go $ do + c <- liftIO $ B.hGetNonBlocking h (min k i) + case B.length c of + 0 -> return (Empty ()) + m -> return (Chunk c (readChunks (i - m))) +hGetNonBlockingN _ _ 0 = Empty () +hGetNonBlockingN _ h n = liftIO $ illegalBufferSize h "hGetNonBlocking" n +{-# INLINABLE hGetNonBlockingN #-} + +illegalBufferSize :: Handle -> String -> Int -> IO a +illegalBufferSize handle fn sz = + ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing) + --TODO: System.IO uses InvalidArgument here, but it's not exported :-( + where + msg = fn ++ ": illegal ByteStream size " ++ showsPrec 9 sz [] +{-# INLINABLE illegalBufferSize #-} + +-- | Read entire handle contents /lazily/ into a 'ByteStream'. Chunks are read +-- on demand, using the default chunk size. +-- +-- Note: the 'Handle' should be placed in binary mode with +-- 'System.IO.hSetBinaryMode' for 'hGetContents' to work correctly. +hGetContents :: MonadIO m => Handle -> ByteStream m () +hGetContents = hGetContentsN defaultChunkSize +{-# INLINE hGetContents #-} + +-- | Pipes-style nomenclature for 'hGetContents'. +fromHandle :: MonadIO m => Handle -> ByteStream m () +fromHandle = hGetContents +{-# INLINE fromHandle #-} + +-- | Pipes-style nomenclature for 'getContents'. +stdin :: MonadIO m => ByteStream m () +stdin = hGetContents IO.stdin +{-# INLINE stdin #-} + +-- | Read @n@ bytes into a 'ByteStream', directly from the specified 'Handle'. +hGet :: MonadIO m => Handle -> Int -> ByteStream m () +hGet = hGetN defaultChunkSize +{-# INLINE hGet #-} + +-- | hGetNonBlocking is similar to 'hGet', except that it will never block +-- waiting for data to become available, instead it returns only whatever data +-- is available. If there is no data available to be read, 'hGetNonBlocking' +-- returns 'empty'. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hGet'. +hGetNonBlocking :: MonadIO m => Handle -> Int -> ByteStream m () +hGetNonBlocking = hGetNonBlockingN defaultChunkSize +{-# INLINE hGetNonBlocking #-} + +-- | Write a 'ByteStream' to a file. Use +-- 'Control.Monad.Trans.ResourceT.runResourceT' to ensure that the handle is +-- closed. +-- +-- >>> :set -XOverloadedStrings +-- >>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" +-- >>> :! cat "hello.txt" +-- Hello world. +-- Goodbye world. +-- >>> runResourceT $ Q.writeFile "hello2.txt" $ Q.readFile "hello.txt" +-- >>> :! cat hello2.txt +-- Hello world. +-- Goodbye world. +writeFile :: MonadResource m => FilePath -> ByteStream m r -> m r +writeFile f str = do + (key, handle) <- allocate (openBinaryFile f WriteMode) hClose + r <- hPut handle str + release key + return r +{-# INLINE writeFile #-} + +-- | Read an entire file into a chunked @'ByteStream' IO ()@. The handle will be +-- held open until EOF is encountered. The block governed by +-- 'Control.Monad.Trans.Resource.runResourceT' will end with the closing of any +-- handles opened. +-- +-- >>> :! cat hello.txt +-- Hello world. +-- Goodbye world. +-- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" +-- Hello world. +-- Goodbye world. +readFile :: MonadResource m => FilePath -> ByteStream m () +readFile f = bracketByteString (openBinaryFile f ReadMode) hClose hGetContents +{-# INLINE readFile #-} + +-- | Append a 'ByteStream' to a file. Use +-- 'Control.Monad.Trans.ResourceT.runResourceT' to ensure that the handle is +-- closed. +-- +-- >>> runResourceT $ Q.writeFile "hello.txt" "Hello world.\nGoodbye world.\n" +-- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" +-- Hello world. +-- Goodbye world. +-- >>> runResourceT $ Q.appendFile "hello.txt" "sincerely yours,\nArthur\n" +-- >>> runResourceT $ Q.stdout $ Q.readFile "hello.txt" +-- Hello world. +-- Goodbye world. +-- sincerely yours, +-- Arthur +appendFile :: MonadResource m => FilePath -> ByteStream m r -> m r +appendFile f str = do + (key, handle) <- allocate (openBinaryFile f AppendMode) hClose + r <- hPut handle str + release key + return r +{-# INLINE appendFile #-} + +-- | Equivalent to @hGetContents stdin@. Will read /lazily/. +getContents :: MonadIO m => ByteStream m () +getContents = hGetContents IO.stdin +{-# INLINE getContents #-} + +-- | Outputs a 'ByteStream' to the specified 'Handle'. +hPut :: MonadIO m => Handle -> ByteStream m r -> m r +hPut h cs = dematerialize cs return (\x y -> liftIO (B.hPut h x) >> y) (>>= id) +{-# INLINE hPut #-} + +-- | Pipes nomenclature for 'hPut'. +toHandle :: MonadIO m => Handle -> ByteStream m r -> m r +toHandle = hPut +{-# INLINE toHandle #-} + +-- | Pipes-style nomenclature for @putStr@. +stdout :: MonadIO m => ByteStream m r -> m r +stdout = hPut IO.stdout +{-# INLINE stdout #-} + +-- -- | Similar to 'hPut' except that it will never block. Instead it returns +-- any tail that did not get written. This tail may be 'empty' in the case that +-- the whole string was written, or the whole original string if nothing was +-- written. Partial writes are also possible. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hPut'. +-- +-- hPutNonBlocking :: MonadIO m => Handle -> ByteStream m r -> ByteStream m r +-- hPutNonBlocking _ (Empty r) = Empty r +-- hPutNonBlocking h (Go m) = Go $ fmap (hPutNonBlocking h) m +-- hPutNonBlocking h bs@(Chunk c cs) = do +-- c' <- lift $ B.hPutNonBlocking h c +-- case B.length c' of +-- l' | l' == B.length c -> hPutNonBlocking h cs +-- 0 -> bs +-- _ -> Chunk c' cs +-- {-# INLINABLE hPutNonBlocking #-} + +-- | A synonym for @hPut@, for compatibility +-- +-- hPutStr :: Handle -> ByteStream IO r -> IO r +-- hPutStr = hPut +-- +-- -- | Write a ByteStream to stdout +-- putStr :: ByteStream IO r -> IO r +-- putStr = hPut IO.stdout + +-- | The interact function takes a function of type @ByteStream -> ByteStream@ +-- as its argument. The entire input from the standard input device is passed to +-- this function as its argument, and the resulting string is output on the +-- standard output device. +-- +-- > interact morph = stdout (morph stdin) +interact :: (ByteStream IO () -> ByteStream IO r) -> IO r +interact f = stdout (f stdin) +{-# INLINE interact #-} + +-- -- --------------------------------------------------------------------- +-- -- Internal utilities + +-- | Used in `group` and `groupBy`. +revNonEmptyChunks :: [P.ByteString] -> ByteStream m r -> ByteStream m r +revNonEmptyChunks = L.foldl' (\f bs -> Chunk bs . f) id +{-# INLINE revNonEmptyChunks #-} + +-- | Reverse a list of possibly-empty chunks into a lazy ByteString. +revChunks :: Monad m => [P.ByteString] -> r -> ByteStream m r +revChunks cs r = L.foldl' (flip Chunk) (Empty r) cs +{-# INLINE revChunks #-} + +-- | Zip a list and a stream-of-byte-streams together. +zipWithStream + :: (Monad m) + => (forall x . a -> ByteStream m x -> ByteStream m x) + -> [a] + -> Stream (ByteStream m) m r + -> Stream (ByteStream m) m r +zipWithStream op zs = loop zs + where + loop [] !ls = loop zs ls + loop a@(x:xs) ls = case ls of + Return r -> Return r + Step fls -> Step $ fmap (loop xs) (op x fls) + Effect mls -> Effect $ fmap (loop a) mls +{-# INLINABLE zipWithStream #-} + +-- | Take a builder constructed otherwise and convert it to a genuine streaming +-- bytestring. +-- +-- >>> Q.putStrLn $ Q.toStreamingByteString $ stringUtf8 "哈斯克尔" <> stringUtf8 " " <> integerDec 98 +-- 哈斯克尔 98 +-- +-- shows +-- its indistinguishable performance is indistinguishable from +-- @toLazyByteString@ +toStreamingByteString :: MonadIO m => Builder -> ByteStream m () +toStreamingByteString = toStreamingByteStringWith + (safeStrategy BI.smallChunkSize BI.defaultChunkSize) +{-# INLINE toStreamingByteString #-} + +-- | Take a builder and convert it to a genuine streaming bytestring, using a +-- specific allocation strategy. +toStreamingByteStringWith :: MonadIO m => AllocationStrategy -> Builder -> ByteStream m () +toStreamingByteStringWith strategy builder0 = do + cios <- liftIO (buildStepToCIOS strategy (runBuilder builder0)) + let loop cios0 = case cios0 of + Yield1 bs io -> Chunk bs $ do + cios1 <- liftIO io + loop cios1 + Finished buf r -> trimmedChunkFromBuffer buf (Empty r) + trimmedChunkFromBuffer buffer k + | B.null bs = k + | 2 * B.length bs < bufferSize buffer = Chunk (B.copy bs) k + | otherwise = Chunk bs k + where + bs = byteStringFromBuffer buffer + loop cios +{-# INLINABLE toStreamingByteStringWith #-} +{-# SPECIALIZE toStreamingByteStringWith :: AllocationStrategy -> Builder -> ByteStream IO () #-} + +-- | Concatenate a stream of builders (not a streaming bytestring!) into a +-- single builder. +-- +-- >>> let aa = yield (integerDec 10000) >> yield (string8 " is a number.") >> yield (char8 '\n') +-- >>> hPutBuilder IO.stdout $ concatBuilders aa +-- 10000 is a number. +concatBuilders :: Stream (Of Builder) IO () -> Builder +concatBuilders p = builder $ \bstep r -> do + case p of + Return _ -> runBuilderWith mempty bstep r + Step (b :> rest) -> runBuilderWith (b `mappend` concatBuilders rest) bstep r + Effect m -> m >>= \p' -> runBuilderWith (concatBuilders p') bstep r +{-# INLINABLE concatBuilders #-} + +-- | A simple construction of a builder from a 'ByteString'. +-- +-- >>> let aaa = "10000 is a number\n" :: Q.ByteString IO () +-- >>> hPutBuilder IO.stdout $ toBuilder aaa +-- 10000 is a number +toBuilder :: ByteStream IO () -> Builder +toBuilder = concatBuilders . SP.map byteString . toChunks +{-# INLINABLE toBuilder #-} diff --git a/lib/Streaming/ByteString/Char8.hs b/lib/Streaming/ByteString/Char8.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/ByteString/Char8.hs @@ -0,0 +1,899 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- 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 +-- . 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 -- empty :: ByteStream m () + , pack -- pack :: Monad m => String -> ByteStream m () + , unpack + , string + , unlines + , unwords + , singleton -- singleton :: Monad m => Char -> ByteStream m () + , fromChunks -- fromChunks :: Monad m => Stream (Of ByteString) m r -> ByteStream m r + , fromLazy -- fromLazy :: Monad m => ByteString -> ByteStream m () + , fromStrict -- fromStrict :: ByteString -> ByteStream m () + , toChunks -- toChunks :: Monad m => ByteStream m r -> Stream (Of ByteString) m r + , toLazy -- toLazy :: Monad m => ByteStream m () -> m ByteString + , toLazy_ + , toStrict -- toStrict :: Monad m => ByteStream m () -> m ByteString + , toStrict_ + , effects + , copy + , drained + , mwrap + + -- * Transforming ByteStreams + , map -- map :: Monad m => (Char -> Char) -> ByteStream m r -> ByteStream m r + , intercalate -- intercalate :: Monad m => ByteStream m () -> Stream (ByteStream m) m r -> ByteStream m r + , intersperse -- intersperse :: Monad m => Char -> ByteStream m r -> ByteStream m r + + -- * Basic interface + , cons -- cons :: Monad m => Char -> ByteStream m r -> ByteStream m r + , cons' -- cons' :: Char -> ByteStream m r -> ByteStream m r + , snoc + , append -- append :: Monad m => ByteStream m r -> ByteStream m s -> ByteStream m s + , filter -- filter :: (Char -> Bool) -> ByteStream m r -> ByteStream m r + , head -- head :: Monad m => ByteStream m r -> m Char + , head_ -- head' :: Monad m => ByteStream m r -> m (Of Char r) + , last -- last :: Monad m => ByteStream m r -> m Char + , last_ -- last' :: Monad m => ByteStream m r -> m (Of Char r) + , null -- null :: Monad m => ByteStream m r -> m Bool + , null_ + , testNull + , nulls -- null' :: Monad m => ByteStream m r -> m (Of Bool r) + , uncons -- uncons :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r)) + , nextChar + , skipSomeWS + + -- * Substrings + -- ** Breaking strings + , break -- break :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) + , drop -- drop :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m r + , dropWhile + , group -- group :: Monad m => ByteStream m r -> Stream (ByteStream m) m r + , groupBy + , span -- span :: Monad m => (Char -> Bool) -> ByteStream m r -> ByteStream m (ByteStream m r) + , splitAt -- splitAt :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m (ByteStream m r) + , splitWith -- splitWith :: Monad m => (Char -> Bool) -> ByteStream m r -> Stream (ByteStream m) m r + , take -- take :: Monad m => GHC.Int.Int64 -> ByteStream m r -> ByteStream m () + , takeWhile -- takeWhile :: (Char -> Bool) -> ByteStream m r -> ByteStream m () + + -- ** Breaking into many substrings + , split -- split :: Monad m => Char -> ByteStream m r -> Stream (ByteStream m) m r + , lines + , words + , lineSplit + , denull + + -- ** Special folds + , concat -- concat :: Monad m => Stream (ByteStream m) m r -> ByteStream m r + + -- * Builders + , toStreamingByteString + , toStreamingByteStringWith + , toBuilder + , concatBuilders + + -- * Building ByteStreams + -- ** Infinite ByteStreams + , repeat -- repeat :: Char -> ByteStream m () + , iterate -- iterate :: (Char -> Char) -> Char -> ByteStream m () + , cycle -- cycle :: Monad m => ByteStream m r -> ByteStream m s + + -- ** Unfolding ByteStreams + , unfoldr -- unfoldr :: (a -> Maybe (Char, a)) -> a -> ByteStream m () + , unfoldM -- unfold :: (a -> Either r (Char, a)) -> a -> ByteStream m r + , reread + + -- * Folds, including support for `Control.Foldl` +-- , foldr -- foldr :: Monad m => (Char -> a -> a) -> a -> ByteStream m () -> m a + , fold -- fold :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m () -> m b + , fold_ -- fold' :: Monad m => (x -> Char -> x) -> x -> (x -> b) -> ByteStream m r -> m (b, r) + , length + , length_ + , count + , count_ + , readInt + + -- * I\/O with 'ByteStream's + -- ** Standard input and output + , getContents -- getContents :: ByteStream IO () + , stdin -- stdin :: ByteStream IO () + , stdout -- stdout :: ByteStream IO r -> IO r + , interact -- interact :: (ByteStream IO () -> ByteStream IO r) -> IO r + , putStr + , putStrLn + + -- ** Files + , readFile -- readFile :: FilePath -> ByteStream IO () + , writeFile -- writeFile :: FilePath -> ByteStream IO r -> IO r + , appendFile -- appendFile :: FilePath -> ByteStream IO r -> IO r + + -- ** I\/O with Handles + , fromHandle -- fromHandle :: Handle -> ByteStream IO () + , toHandle -- toHandle :: Handle -> ByteStream IO r -> IO r + , hGet -- hGet :: Handle -> Int -> ByteStream IO () + , hGetContents -- hGetContents :: Handle -> ByteStream IO () + , hGetContentsN -- hGetContentsN :: Int -> Handle -> ByteStream IO () + , hGetN -- hGetN :: Int -> Handle -> Int -> ByteStream IO () + , hGetNonBlocking -- hGetNonBlocking :: Handle -> Int -> ByteStream IO () + , hGetNonBlockingN -- hGetNonBlockingN :: Int -> Handle -> Int -> ByteStream IO () + , hPut -- hPut :: Handle -> ByteStream IO r -> IO r +-- , hPutNonBlocking -- hPutNonBlocking :: Handle -> ByteStream IO r -> ByteStream IO r + + -- * Simple chunkwise operations + , unconsChunk + , nextChunk + , chunk + , foldrChunks + , foldlChunks + , chunkFold + , chunkFoldM + , chunkMap + , chunkMapM + , chunkMapM_ + + -- * Etc. +-- , zipWithStream -- zipWithStream :: Monad m => (forall x. a -> ByteStream m x -> ByteStream m x) -> [a] -> Stream (ByteStream m) m r -> Stream (ByteStream m) m r + , distribute -- distribute :: ByteStream (t m) a -> t (ByteStream m) a + , materialize + , dematerialize + ) 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) + +import Data.Word (Word8) +import Foreign.ForeignPtr (withForeignPtr) +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 bs = case bs of + Empty r -> Return r + Go m -> Effect (fmap unpack m) + Chunk c cs -> unpackAppendCharsLazy c (unpack cs) + where + unpackAppendCharsLazy :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r + unpackAppendCharsLazy (B.PS fp off len) xs + | len <= 100 = unpackAppendCharsStrict (B.PS fp off len) xs + | otherwise = unpackAppendCharsStrict (B.PS fp off 100) remainder + where + remainder = unpackAppendCharsLazy (B.PS fp (off+100) (len-100)) xs + + unpackAppendCharsStrict :: B.ByteString -> Stream (Of Char) m r -> Stream (Of Char) m r + unpackAppendCharsStrict (B.PS fp off len) xs = + B.accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> do + loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs + where + loop !sentinal !p acc + | p == sentinal = return acc + | otherwise = do x <- peek p + loop sentinal (p `plusPtr` (-1)) (Step (B.w2c x :> 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 = fromChunks + . mapped (fmap (\(str :> r) -> Char8.pack str :> r) . SP.toList) + . chunksOf 32 +{-# INLINABLE pack #-} + +-- | /O(1)/ Cons a 'Char' onto a byte stream. +cons :: Monad m => Char -> ByteStream m r -> ByteStream m r +cons c = Q.cons (c2w c) +{-# INLINE cons #-} + +-- | /O(1)/ Yield a 'Char' as a minimal 'ByteStream' +singleton :: Monad m => Char -> ByteStream m () +singleton = Q.singleton . 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' c (Chunk bs bss) | B.length bs < 16 = Chunk (B.cons (c2w c) bs) bss +cons' c cs = Chunk (B.singleton (c2w c)) 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 cs = Q.snoc cs . 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_ = fmap w2c . 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 = fmap (\(m:>r) -> fmap w2c m :> 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_ = fmap w2c . 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 = fmap (\(m:>r) -> fmap w2c m :> 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 rel = Q.groupBy (\w w' -> rel (w2c w) (w2c w')) +{-# INLINE groupBy #-} + +-- | /O(1)/ Extract the head and tail of a ByteStream, returning Nothing +-- if it is empty. +uncons :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r)) +uncons (Empty r) = return (Left r) +uncons (Chunk c cs) + = return $ Right (w2c (B.unsafeHead c) + , if B.length c == 1 + then cs + else Chunk (B.unsafeTail c) cs ) +uncons (Go m) = m >>= uncons +{-# INLINABLE uncons #-} + +-- --------------------------------------------------------------------- +-- 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 f = Q.map (c2w . f . 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 c = Q.intersperse (c2w 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_ step begin done p0 = loop p0 begin + where + loop p !x = case p of + Chunk bs bss -> loop bss $! Char8.foldl' step x bs + Go m -> m >>= \p' -> loop p' x + Empty _ -> return (done 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 step begin done p0 = loop p0 begin + where + loop p !x = case p of + Chunk bs bss -> loop bss $! Char8.foldl' step x bs + Go m -> m >>= \p' -> loop p' x + Empty r -> return (done x :> 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 f c = Q.iterate (c2w . f . w2c) (c2w c) +{-# INLINE iterate #-} + +-- | @'repeat' x@ is an infinite ByteStream, with @x@ the value of every +-- element. +repeat :: Char -> ByteStream m r +repeat = Q.repeat . 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 f = Q.unfoldM go where + go a = case f a of + Nothing -> Nothing + Just (c,a') -> Just (c2w c, 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 step = Q.unfoldr (either Left (\(c,a) -> Right (c2w c,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 f = Q.takeWhile (f . 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 f = Q.dropWhile (f . 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 f = Q.break (f . 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 p = break (not . 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 f = Q.splitWith (f . 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 c = Q.split (c2w 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 p = Q.filter (p . 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 text0 = loop1 text0 + where + loop1 :: ByteStream m r -> Stream (ByteStream m) m r + loop1 text = + case text of + Empty r -> Return r + Go m -> Effect $ fmap loop1 m + Chunk c cs + | B.null c -> loop1 cs + | otherwise -> Step (loop2 False text) + loop2 :: Bool -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) + loop2 prevCr text = + case text of + Empty r -> if prevCr + then Chunk (B.singleton 13) (Empty (Return r)) + else Empty (Return r) + Go m -> Go $ fmap (loop2 prevCr) m + Chunk c cs -> + case B.elemIndex 10 c of + Nothing -> if B.null c + then loop2 prevCr cs + else if unsafeLast c == 13 + then Chunk (unsafeInit c) (loop2 True cs) + else Chunk c (loop2 False cs) + Just i -> do + let prefixLength = + if i >= 1 && B.unsafeIndex c (i-1) == 13 -- \r\n (dos) + then i-1 + else i + rest = + if B.length c > i+1 + then Chunk (B.drop (i+1) c) cs + else cs + result = Chunk (B.unsafeTake prefixLength c) (Empty (loop1 rest)) + if i > 0 && prevCr + then Chunk (B.singleton 13) result + else 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 = loop where + loop str = case str of + Return r -> Empty r + Step bstr -> do + st <- bstr + let bs = unlines st + case bs of + Chunk "" (Empty r) -> Empty r + Chunk "\n" (Empty _) -> bs + _ -> cons' '\n' bs + Effect m -> Go (fmap unlines 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 = filtered . Q.splitWith B.isSpaceWord8 + where + filtered stream = case stream of + Return r -> Return r + Effect m -> Effect (fmap filtered m) + Step bs -> Effect $ bs_loop bs + bs_loop bs = case bs of + Empty r -> return $ filtered r + Go m -> m >>= bs_loop + Chunk b bs' -> if B.null b + then bs_loop bs' + else return $ Step $ Chunk b (fmap filtered 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 = intercalate (singleton ' ') +{-# 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 !n0 text0 = loop1 text0 + where + n :: Int + !n = max n0 1 + loop1 :: ByteStream m r -> Stream (ByteStream m) m r + loop1 text = + case text of + Empty r -> Return r + Go m -> Effect $ fmap loop1 m + Chunk c cs + | B.null c -> loop1 cs + | otherwise -> Step (loop2 0 text) + loop2 :: Int -> ByteStream m r -> ByteStream m (Stream (ByteStream m) m r) + loop2 !counter text = + case text of + Empty r -> Empty (Return r) + Go m -> Go $ fmap (loop2 counter) m + Chunk c cs -> + case nthNewLine c (n - counter) of + Left !i -> Chunk c (loop2 (counter + i) cs) + Right !l -> Chunk (B.unsafeTake l c) + $ Empty $ loop1 $! Chunk (B.unsafeDrop l c) 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 (B.PS fp off len) targetLines = + B.accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> + loop (base `plusPtr` off) targetLines 0 len + where + loop :: Ptr Word8 -> Int -> Int -> Int -> IO (Either Int Int) + loop !_ 0 !startIx !_ = return $ Right startIx + loop !p !linesNeeded !startIx !bytesLeft = do + q <- B.memchr p newline $ fromIntegral bytesLeft + if q == nullPtr + then return $ Left $! targetLines - linesNeeded + else let !pnext = q `plusPtr` 1 + !skip = pnext `minusPtr` p + !snext = startIx + skip + !bytes = bytesLeft - skip + in loop pnext (linesNeeded - 1) snext bytes + +newline :: Word8 +newline = 10 +{-# INLINE newline #-} + +-- | Promote a vanilla `String` into a stream. +-- +-- /Note:/ Each `Char` is truncated to 8 bits. +string :: String -> ByteStream m () +string = chunk . B.pack . Prelude.map 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_ c = Q.count_ (c2w 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 c = Q.count (c2w c) +{-# INLINE count #-} + +-- | /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. +nextChar :: Monad m => ByteStream m r -> m (Either r (Char, ByteStream m r)) +nextChar b = do + e <- Q.nextByte b + case e of + Left r -> return $! Left r + Right (w,bs) -> return $! Right (w2c w, bs) + +-- | Print a stream of bytes to STDOUT. +putStr :: MonadIO m => ByteStream m r -> m r +putStr = hPut 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 bs = hPut IO.stdout (snoc bs '\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 = fromIntegral (maxBound :: Int) +intminWord = fromIntegral (negate (minBound :: Int)) +(intmaxQuot10, intmaxRem10) = intmaxWord `quotRem` 10 +(intminQuot10, intminRem10) = intminWord `quotRem` 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 = \ !w8 -> + -- Avoid the cost of narrowing arithmetic results to Word8, + -- the conversion from Word8 to Word is free. + let w :: Word + !w = fromIntegral w8 + in w - 0x21 > 0x7e -- not [x21..0x9f] + && ( w == 0x20 -- SP + || w - 0x09 < 5 -- HT, NL, VT, FF, CR + || w == 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 = go 0 + where + go !n (Chunk c cs) + | k <- B.dropWhile w8IsSpace c + , not $ B.null k = Chunk k cs + | n' <- n + B.length c + , n' < defaultChunkSize = go n' cs + | otherwise = cs + go !n (Go m) = Go $ go n <$> m + go _ 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 = start + where + nada str = return $! Compose $ Nothing :> str + + start bs@(Chunk c cs) + | B.null c = start cs + | w <- B.unsafeHead c + = if | w - 0x30 <= 9 -> readDec True Nothing bs + | let rest = Chunk (B.tail c) cs + -> if | w == 0x2b -> readDec True (Just w) rest + | w == 0x2d -> readDec False (Just w) rest + | otherwise -> nada bs + start (Go m) = m >>= start + start bs@(Empty _) = nada 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 !positive signByte = loop 0 0 + where + loop !nbytes !acc = \ str -> case str of + Empty _ -> result nbytes acc str + Go m -> m >>= loop nbytes acc + Chunk c cs + | !l <- B.length c + , l > 0 -> case accumWord acc c of + (0, !_, !_) + -- no more digits found + -> result nbytes acc str + (!n, !a, !inrange) + | False <- inrange + -- result out of 'Int' range + -> overflow nbytes acc str + | n < l, !t <- B.drop n c + -- input not entirely digits + -> result (nbytes + n) a $ Chunk t cs + | a > 0 || nbytes + n < defaultChunkSize + -- if all zeros, not yet too many + -> loop (nbytes + n) a cs + | otherwise + -- too many zeros, bail out with sign + -> overflow nbytes acc str + | otherwise + -- skip empty segment + -> loop nbytes acc 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 acc (B.PS fp off len) = + B.accursedUnutterablePerformIO $ do + withForeignPtr fp $ \p -> do + let ptr = p `plusPtr` off + end = ptr `plusPtr` len + x@(!_, !_, !_) <- if positive + then digits intmaxQuot10 intmaxRem10 end ptr 0 acc + else digits intminQuot10 intminRem10 end ptr 0 acc + return x + where + digits !maxq !maxr !e !ptr = go ptr + where + go :: Ptr Word8 -> Int -> Word -> IO (Int, Word, Bool) + go !p !b !a | p == e = return (b, a, True) + go !p !b !a = do + !byte <- peek p + let !w = byte - 0x30 + !d = fromIntegral w + if | w > 9 + -- No more digits + -> return (b, a, True) + | a < maxq + -- Look for more + -> go (p `plusPtr` 1) (b + 1) (a * 10 + d) + | a > maxq + -- overflow + -> return (b, a, False) + | d <= maxr + -- Ideally this will be the last digit + -> go (p `plusPtr` 1) (b + 1) (a * 10 + d) + | otherwise + -- overflow + -> return (b, a, False) + + -- | Plausible success, provided we got at least one digit! + result !nbytes !acc str + | nbytes > 0, !i <- w2int acc = return $! Compose $ Just i :> str + | otherwise = overflow nbytes acc 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 !n | positive = fromIntegral n + | otherwise = negate $! fromIntegral n + + -- | Reconstruct any consumed input, and report failure + overflow 0 _ str = case signByte of + Nothing -> return $ Compose $ Nothing :> str + Just w -> return $ Compose $ Nothing :> Chunk (B.singleton w) str + overflow !nbytes !acc str = + let !c = overflowBytes nbytes acc + in return $! Compose $ Nothing :> Chunk c 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 !nbytes !acc = + B.unsafeCreate (nbytes + signlen) $ \p -> do + let end = p `plusPtr` (signlen - 1) + ptr = p `plusPtr` (nbytes + signlen - 1) + go end ptr acc + mapM_ (poke p) signByte + where + signlen = if signByte == Nothing then 0 else 1 + + go :: Ptr Word8 -> Ptr Word8 -> Word -> IO () + go end !ptr !_ | end == ptr = return () + go end !ptr !a = do + let (q, r) = a `quotRem` 10 + poke ptr $ fromIntegral r + 0x30 + go end (ptr `plusPtr` (-1)) q diff --git a/lib/Streaming/ByteString/Internal.hs b/lib/Streaming/ByteString/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/ByteString/Internal.hs @@ -0,0 +1,561 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UnliftedFFITypes #-} + +-- | +-- Module : Streaming.ByteString.Internal +-- Copyright : (c) Don Stewart 2006 +-- (c) Duncan Coutts 2006-2011 +-- (c) Michael Thompson 2015 +-- License : BSD-style + +module Streaming.ByteString.Internal + ( ByteStream(..) + , ByteString + , consChunk -- :: ByteString -> ByteStream m r -> ByteStream m r + , chunkOverhead -- :: Int + , defaultChunkSize -- :: Int + , materialize -- :: (forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r + , dematerialize -- :: Monad m => ByteStream m r -> forall x. (r -> x) -> (ByteString -> x -> x) -> (m x -> x) -> x + , foldrChunks -- :: Monad m => (ByteString -> a -> a) -> a -> ByteStream m r -> m a + , foldlChunks -- :: Monad m => (a -> ByteString -> a) -> a -> ByteStream m r -> m a + + , foldrChunksM -- :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a + , foldlChunksM -- :: Monad m => (ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a + , chunkFold + , chunkFoldM + , chunkMap + , chunkMapM + , chunkMapM_ + , unfoldMChunks + , unfoldrChunks + + , packChars + , smallChunkSize -- :: Int + , unpackBytes -- :: Monad m => ByteStream m r -> Stream (Of Word8) m r + , packBytes + , chunk -- :: ByteString -> ByteStream m () + , mwrap + , unfoldrNE + , reread + , unsafeLast + , unsafeInit + , copy + , findIndexOrEnd + + -- * ResourceT help + , bracketByteString + ) where + +import Control.Monad +import Control.Monad.Morph +import Control.Monad.Trans +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, unzip, writeFile, zip, zipWith) +import qualified Prelude + +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif + +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B + +import Streaming (Of(..)) +import Streaming.Internal hiding (concats) +import qualified Streaming.Prelude as SP + +import Data.String +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr +import Foreign.Storable +import GHC.Exts (SpecConstrAnnotation(..)) + +import Data.Functor.Identity +import Data.Word +import GHC.Base (realWorld#) +import GHC.IO (IO(IO)) +import System.IO.Unsafe + +import Control.Monad.Base +import Control.Monad.Catch (MonadCatch(..)) +import Control.Monad.Trans.Resource + +-- | A type alias for back-compatibility. +type ByteString = ByteStream +{-# DEPRECATED ByteString "Use ByteStream instead." #-} + +-- | A space-efficient representation of a succession of 'Word8' vectors, +-- supporting many efficient operations. +-- +-- An effectful 'ByteStream' contains 8-bit bytes, or by using the operations +-- from "Streaming.ByteString.Char8" it can be interpreted as containing +-- 8-bit characters. +data ByteStream m r = + Empty r + | Chunk {-# UNPACK #-} !B.ByteString (ByteStream m r ) + | Go (m (ByteStream m r )) + +instance Monad m => Functor (ByteStream m) where + fmap f x = case x of + Empty a -> Empty (f a) + Chunk bs bss -> Chunk bs (fmap f bss) + Go mbss -> Go (fmap (fmap f) mbss) + +instance Monad m => Applicative (ByteStream m) where + pure = Empty + {-# INLINE pure #-} + bf <*> bx = do {f <- bf; x <- bx; Empty (f x)} + {-# INLINE (<*>) #-} + (*>) = (>>) + {-# INLINE (*>) #-} + +instance Monad m => Monad (ByteStream m) where + return = Empty + {-# INLINE return #-} + x0 >> y = loop SPEC x0 where + loop !_ x = case x of -- this seems to be insanely effective + Empty _ -> y + Chunk a b -> Chunk a (loop SPEC b) + Go m -> Go (fmap (loop SPEC) m) + {-# INLINEABLE (>>) #-} + x >>= f = + -- case x of + -- Empty a -> f a + -- Chunk bs bss -> Chunk bs (bss >>= f) + -- Go mbss -> Go (fmap (>>= f) mbss) + loop SPEC2 x where -- unlike >> this SPEC seems pointless + loop !_ y = case y of + Empty a -> f a + Chunk bs bss -> Chunk bs (loop SPEC bss) + Go mbss -> Go (fmap (loop SPEC) mbss) + {-# INLINEABLE (>>=) #-} + +instance MonadIO m => MonadIO (ByteStream m) where + liftIO io = Go (fmap Empty (liftIO io)) + {-# INLINE liftIO #-} + +instance MonadTrans ByteStream where + lift ma = Go $ fmap Empty ma + {-# INLINE lift #-} + +instance MFunctor ByteStream where + hoist phi bs = case bs of + Empty r -> Empty r + Chunk bs' rest -> Chunk bs' (hoist phi rest) + Go m -> Go (phi (fmap (hoist phi) m)) + {-# INLINABLE hoist #-} + +instance (r ~ ()) => IsString (ByteStream m r) where + fromString = chunk . B.pack . Prelude.map B.c2w + {-# INLINE fromString #-} + +instance (m ~ Identity, Show r) => Show (ByteStream m r) where + show bs0 = case bs0 of -- the implementation this instance deserves ... + Empty r -> "Empty (" ++ show r ++ ")" + Go (Identity bs') -> "Go (Identity (" ++ show bs' ++ "))" + Chunk bs'' bs -> "Chunk " ++ show bs'' ++ " (" ++ show bs ++ ")" + +instance (Semigroup r, Monad m) => Semigroup (ByteStream m r) where + (<>) = liftM2 (<>) + {-# INLINE (<>) #-} + +instance (Monoid r, Monad m) => Monoid (ByteStream m r) where + mempty = Empty mempty + {-# INLINE mempty #-} + mappend = liftM2 mappend + {-# INLINE mappend #-} + +instance (MonadBase b m) => MonadBase b (ByteStream m) where + liftBase = mwrap . fmap return . liftBase + {-# INLINE liftBase #-} + +instance (MonadThrow m) => MonadThrow (ByteStream m) where + throwM = lift . throwM + {-# INLINE throwM #-} + +instance (MonadCatch m) => MonadCatch (ByteStream m) where + catch str f = go str + where + go p = case p of + Chunk bs rest -> Chunk bs (go rest) + Empty r -> Empty r + Go m -> Go (catch (do + p' <- m + return (go p')) + (return . f)) + {-# INLINABLE catch #-} + +instance (MonadResource m) => MonadResource (ByteStream m) where + liftResourceT = lift . liftResourceT + {-# INLINE liftResourceT #-} + +-- | Like @bracket@, but specialized for `ByteString`. +bracketByteString :: MonadResource m => IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b +bracketByteString alloc free inside = do + (key, seed) <- lift (allocate alloc free) + clean key (inside seed) + where + clean key = loop where + loop str = case str of + Empty r -> Go (release key >> return (Empty r)) + Go m -> Go (fmap loop m) + Chunk bs rest -> Chunk bs (loop rest) +{-# INLINABLE bracketByteString #-} + +data SPEC = SPEC | SPEC2 +{-# ANN type SPEC ForceSpecConstr #-} + +-- -- ------------------------------------------------------------------------ +-- +-- | Smart constructor for 'Chunk'. +consChunk :: B.ByteString -> ByteStream m r -> ByteStream m r +consChunk c@(B.PS _ _ len) cs + | len == 0 = cs + | otherwise = Chunk c cs +{-# INLINE consChunk #-} + +-- | Yield-style smart constructor for 'Chunk'. +chunk :: B.ByteString -> ByteStream m () +chunk bs = consChunk bs (Empty ()) +{-# INLINE chunk #-} + + +{- | Reconceive an effect that results in an effectful bytestring as an effectful bytestring. + Compare Streaming.mwrap. The closes equivalent of + +>>> Streaming.wrap :: f (Stream f m r) -> Stream f m r + + is here @consChunk@. @mwrap@ is the smart constructor for the internal @Go@ constructor. +-} +mwrap :: m (ByteStream m r) -> ByteStream m r +mwrap = Go +{-# INLINE mwrap #-} + +-- | Construct a succession of chunks from its Church encoding (compare @GHC.Exts.build@) +materialize :: (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x) -> ByteStream m r +materialize phi = phi Empty Chunk Go +{-# INLINE[0] materialize #-} + +-- | Resolve a succession of chunks into its Church encoding; this is +-- not a safe operation; it is equivalent to exposing the constructors +dematerialize :: Monad m + => ByteStream m r + -> (forall x . (r -> x) -> (B.ByteString -> x -> x) -> (m x -> x) -> x) +dematerialize x0 nil cons mwrap' = loop SPEC x0 + where + loop !_ x = case x of + Empty r -> nil r + Chunk b bs -> cons b (loop SPEC bs ) + Go ms -> mwrap' (fmap (loop SPEC) ms) +{-# INLINE [1] dematerialize #-} + +{-# RULES + "dematerialize/materialize" forall (phi :: forall b . (r -> b) -> (B.ByteString -> b -> b) -> (m b -> b) -> b). dematerialize (materialize phi) = phi ; + #-} +------------------------------------------------------------------------ + +-- The representation uses lists of packed chunks. When we have to convert from +-- a lazy list to the chunked representation, then by default we use this +-- chunk size. Some functions give you more control over the chunk size. +-- +-- Measurements here: +-- http://www.cse.unsw.edu.au/~dons/tmp/chunksize_v_cache.png +-- +-- indicate that a value around 0.5 to 1 x your L2 cache is best. +-- The following value assumes people have something greater than 128k, +-- and need to share the cache with other programs. + +-- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead +defaultChunkSize :: Int +defaultChunkSize = 32 * k - chunkOverhead + where k = 1024 +{-# INLINE defaultChunkSize #-} +-- | The recommended chunk size. Currently set to 4k, less the memory management overhead +smallChunkSize :: Int +smallChunkSize = 4 * k - chunkOverhead + where k = 1024 +{-# INLINE smallChunkSize #-} + +-- | The memory management overhead. Currently this is tuned for GHC only. +chunkOverhead :: Int +chunkOverhead = 2 * sizeOf (undefined :: Int) +{-# INLINE chunkOverhead #-} + +-- | Packing and unpacking from lists +-- packBytes' :: Monad m => [Word8] -> ByteString m () +-- packBytes' cs0 = +-- packChunks 32 cs0 +-- where +-- packChunks n cs = case B.packUptoLenBytes n cs of +-- (bs, []) -> Chunk bs (Empty ()) +-- (bs, cs') -> Chunk bs (packChunks (min (n * 2) BI.smallChunkSize) cs') +-- -- packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) +-- packUptoLenBytes len xs0 = +-- accursedUnutterablePerformIO (createUptoN' len $ \p -> go p len xs0) +-- where +-- go !_ !n [] = return (len-n, []) +-- go !_ !0 xs = return (len, xs) +-- go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs +-- createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (B.ByteString, a) +-- createUptoN' l f = do +-- fp <- B.mallocByteString l +-- (l', res) <- withForeignPtr fp $ \p -> f p +-- assert (l' <= l) $ return (B.PS fp 0 l', res) +-- {-# INLINABLE packBytes' #-} + +packBytes :: Monad m => Stream (Of Word8) m r -> ByteStream m r +packBytes cs0 = do + (bytes :> rest) <- lift $ SP.toList $ SP.splitAt 32 cs0 + case bytes of + [] -> case rest of + Return r -> Empty r + Step as -> packBytes (Step as) -- these two pattern matches + Effect m -> Go $ fmap packBytes m -- should be evaded. + _ -> Chunk (B.packBytes bytes) (packBytes rest) +{-# INLINABLE packBytes #-} + +-- | Convert a vanilla `Stream` of characters into a stream of bytes. +-- +-- /Note:/ Each `Char` value is truncated to 8 bits. +packChars :: Monad m => Stream (Of Char) m r -> ByteStream m r +packChars = packBytes . SP.map B.c2w +{-# INLINABLE packChars #-} + +-- | The reverse of `packChars`. Given a stream of bytes, produce a `Stream` +-- individual bytes. +unpackBytes :: Monad m => ByteStream m r -> Stream (Of Word8) m r +unpackBytes bss = dematerialize bss Return unpackAppendBytesLazy Effect + where + unpackAppendBytesLazy :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r + unpackAppendBytesLazy (B.PS fp off len) xs + | len <= 100 = unpackAppendBytesStrict (B.PS fp off len) xs + | otherwise = unpackAppendBytesStrict (B.PS fp off 100) remainder + where + remainder = unpackAppendBytesLazy (B.PS fp (off+100) (len-100)) xs + + unpackAppendBytesStrict :: B.ByteString -> Stream (Of Word8) m r -> Stream (Of Word8) m r + unpackAppendBytesStrict (B.PS fp off len) xs = + B.accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> + loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs + where + loop !sentinal !p acc + | p == sentinal = return acc + | otherwise = do + x <- peek p + loop sentinal (p `plusPtr` (-1)) (Step (x :> acc)) +{-# INLINABLE unpackBytes #-} + +-- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring. +unsafeLast :: B.ByteString -> Word8 +unsafeLast (B.PS x s l) = + accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1) + where + accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +{-# INLINE unsafeLast #-} + +-- | Copied from Data.ByteString.Unsafe for compatibility with older bytestring. +unsafeInit :: B.ByteString -> B.ByteString +unsafeInit (B.PS ps s l) = B.PS ps s (l-1) +{-# INLINE unsafeInit #-} + +-- | Consume the chunks of an effectful `ByteString` with a natural right fold. +foldrChunks :: Monad m => (B.ByteString -> a -> a) -> a -> ByteStream m r -> m a +foldrChunks step nil bs = dematerialize bs + (\_ -> return nil) + (fmap . step) + join +{-# INLINE foldrChunks #-} + +-- | Consume the chunks of an effectful `ByteString` with a left fold. Suitable +-- for use with `SP.mapped`. +foldlChunks :: Monad m => (a -> B.ByteString -> a) -> a -> ByteStream m r -> m (Of a r) +foldlChunks f z = go z + where go a _ | a `seq` False = undefined + go a (Empty r) = return (a :> r) + go a (Chunk c cs) = go (f a c) cs + go a (Go m) = m >>= go a +{-# INLINABLE foldlChunks #-} + +-- | Instead of mapping over each `Word8` or `Char`, map over each strict +-- `B.ByteString` chunk in the stream. +chunkMap :: Monad m => (B.ByteString -> B.ByteString) -> ByteStream m r -> ByteStream m r +chunkMap f bs = dematerialize bs return (Chunk . f) Go +{-# INLINE chunkMap #-} + +-- | Like `chunkMap`, but map effectfully. +chunkMapM :: Monad m => (B.ByteString -> m B.ByteString) -> ByteStream m r -> ByteStream m r +chunkMapM f bs = dematerialize bs return (\bs' bss -> Go (fmap (`Chunk` bss) (f bs'))) Go +{-# INLINE chunkMapM #-} + +-- | Like `chunkMapM`, but discard the result of each effectful mapping. +chunkMapM_ :: Monad m => (B.ByteString -> m x) -> ByteStream m r -> m r +chunkMapM_ f bs = dematerialize bs return (\bs' mr -> f bs' >> mr) join +{-# INLINE chunkMapM_ #-} + +-- | @chunkFold@ is preferable to @foldlChunks@ since it is an appropriate +-- argument for @Control.Foldl.purely@ which permits many folds and sinks to be +-- run simultaneously on one bytestream. +chunkFold :: Monad m => (x -> B.ByteString -> x) -> x -> (x -> a) -> ByteStream m r -> m (Of a r) +chunkFold step begin done = go begin + where go a _ | a `seq` False = undefined + go a (Empty r) = return (done a :> r) + go a (Chunk c cs) = go (step a c) cs + go a (Go m) = m >>= go a +{-# INLINABLE chunkFold #-} + +-- | 'chunkFoldM' is preferable to 'foldlChunksM' since it is an appropriate +-- argument for 'Control.Foldl.impurely' which permits many folds and sinks to +-- be run simultaneously on one bytestream. +chunkFoldM :: Monad m => (x -> B.ByteString -> m x) -> m x -> (x -> m a) -> ByteStream m r -> m (Of a r) +chunkFoldM step begin done bs = begin >>= go bs + where + go str !x = case str of + Empty r -> done x >>= \a -> return (a :> r) + Chunk c cs -> step x c >>= go cs + Go m -> m >>= \str' -> go str' x +{-# INLINABLE chunkFoldM #-} + +-- | Like `foldlChunks`, but fold effectfully. Suitable for use with `SP.mapped`. +foldlChunksM :: Monad m => (a -> B.ByteString -> m a) -> m a -> ByteStream m r -> m (Of a r) +foldlChunksM f z bs = z >>= \a -> go a bs + where + go !a str = case str of + Empty r -> return (a :> r) + Chunk c cs -> f a c >>= \aa -> go aa cs + Go m -> m >>= go a +{-# INLINABLE foldlChunksM #-} + +-- | Consume the chunks of an effectful ByteString with a natural right monadic fold. +foldrChunksM :: Monad m => (B.ByteString -> m a -> m a) -> m a -> ByteStream m r -> m a +foldrChunksM step nil bs = dematerialize bs (const nil) step join +{-# INLINE foldrChunksM #-} + +-- | Internal utility for @unfoldr@. +unfoldrNE :: Int -> (a -> Either r (Word8, a)) -> a -> (B.ByteString, Either r a) +unfoldrNE i f x0 + | i < 0 = (B.empty, Right x0) + | otherwise = unsafePerformIO $ B.createAndTrim' i $ \p -> go p x0 0 + where + go !p !x !n + | n == i = return (0, n, Right x) + | otherwise = case f x of + Left r -> return (0, n, Left r) + Right (w,x') -> do poke p w + go (p `plusPtr` 1) x' (n+1) +{-# INLINE unfoldrNE #-} + +-- | Given some continual monadic action that produces strict `B.ByteString` +-- chunks, produce a stream of bytes. +unfoldMChunks :: Monad m => (s -> m (Maybe (B.ByteString, s))) -> s -> ByteStream m () +unfoldMChunks step = loop where + loop s = Go $ do + m <- step s + case m of + Nothing -> return (Empty ()) + Just (bs,s') -> return $ Chunk bs (loop s') +{-# INLINABLE unfoldMChunks #-} + +-- | Like `unfoldMChunks`, but feed through a final @r@ return value. +unfoldrChunks :: Monad m => (s -> m (Either r (B.ByteString, s))) -> s -> ByteStream m r +unfoldrChunks step = loop where + loop !s = Go $ do + m <- step s + case m of + Left r -> return (Empty r) + Right (bs,s') -> return $ Chunk bs (loop s') +{-# INLINABLE unfoldrChunks #-} + +-- | Stream chunks from something that contains @IO (Maybe ByteString)@ until it +-- returns 'Nothing'. 'reread' is of particular use rendering @io-streams@ input +-- streams as byte streams in the present sense. +-- +-- > Q.reread Streams.read :: InputStream B.ByteString -> Q.ByteString IO () +-- > Q.reread (liftIO . Streams.read) :: MonadIO m => InputStream B.ByteString -> Q.ByteString m () +-- +-- The other direction here is +-- +-- > Streams.unfoldM Q.unconsChunk :: Q.ByteString IO r -> IO (InputStream B.ByteString) +reread :: Monad m => (s -> m (Maybe B.ByteString)) -> s -> ByteStream m () +reread step s = loop where + loop = Go $ do + m <- step s + case m of + Nothing -> return (Empty ()) + Just a -> return (Chunk a loop) +{-# INLINEABLE reread #-} + +{-| Make the information in a bytestring available to more than one eliminating fold, e.g. + +>>> Q.count 'l' $ Q.count 'o' $ Q.copy $ "hello\nworld" +3 :> (2 :> ()) + +>>> Q.length $ Q.count 'l' $ Q.count 'o' $ Q.copy $ Q.copy "hello\nworld" +11 :> (3 :> (2 :> ())) + +>>> runResourceT $ Q.writeFile "hello2.txt" $ Q.writeFile "hello1.txt" $ Q.copy $ "hello\nworld\n" +>>> :! cat hello2.txt +hello +world +>>> :! cat hello1.txt +hello +world + + This sort of manipulation could as well be acheived by combining folds - using + @Control.Foldl@ for example. But any sort of manipulation can be involved in + the fold. Here are a couple of trivial complications involving splitting by lines: + +>>> let doubleLines = Q.unlines . maps (<* Q.chunk "\n" ) . Q.lines +>>> let emphasize = Q.unlines . maps (<* Q.chunk "!" ) . Q.lines +>>> runResourceT $ Q.writeFile "hello2.txt" $ emphasize $ Q.writeFile "hello1.txt" $ doubleLines $ Q.copy $ "hello\nworld" +>>> :! cat hello2.txt +hello! +world! +>>> :! cat hello1.txt +hello + +world + + As with the parallel operations in @Streaming.Prelude@, we have + +> Q.effects . Q.copy = id +> hoist Q.effects . Q.copy = id + + The duplication does not by itself involve the copying of bytestring chunks; + it just makes two references to each chunk as it arises. This does, however + double the number of constructors associated with each chunk. + +-} +copy :: Monad m => ByteStream m r -> ByteStream (ByteStream m) r +copy = loop where + loop str = case str of + Empty r -> Empty r + Go m -> Go (fmap loop (lift m)) + Chunk bs rest -> Chunk bs (Go (Chunk bs (Empty (loop rest)))) +{-# INLINABLE copy #-} + +-- | 'findIndexOrEnd' is a variant of findIndex, that returns the length of the +-- string if no element is found, rather than Nothing. +findIndexOrEnd :: (Word8 -> Bool) -> B.ByteString -> Int +findIndexOrEnd k (B.PS x s l) = + B.accursedUnutterablePerformIO $ + withForeignPtr x $ \f -> go (f `plusPtr` s) 0 + where + go !ptr !n | n >= l = return l + | otherwise = do w <- peek ptr + if k w + then return n + else go (ptr `plusPtr` 1) (n+1) +{-# INLINABLE findIndexOrEnd #-} diff --git a/streaming-bytestring.cabal b/streaming-bytestring.cabal --- a/streaming-bytestring.cabal +++ b/streaming-bytestring.cabal @@ -1,233 +1,111 @@ -name: streaming-bytestring -version: 0.1.6 -synopsis: effectful byte steams, or: bytestring io done right. - -description: This is an implementation of effectful, memory-constrained - bytestrings (byte streams) and functions for streaming - bytestring manipulation, adequate for non-lazy-io. - Some examples of the use of byte streams to implement simple - shell progams can be found - . - See also the illustrations of use with e.g. @attoparsec@, - @aeson@, @http-client@, @zlib@ etc. in the - - library. Usage is as close as possible to that of @ByteString@ - and lazy @ByteString@. - . - A @ByteString IO ()@ is the most natural representation of - an effectful stream of bytes arising chunkwise from a handle. - Indeed, the implementation follows the - details of @Data.ByteString.Lazy@ and @Data.ByteString.Lazy.Char8@ - in unrelenting detail, omitting only transparently non-streaming - operations like @reverse@. It is just a question of replacing - the lazy bytestring type: - . - > data ByteString = Empty | Chunk Strict.ByteString ByteString - . - with the /minimal/ effectful variant: - . - > data ByteString m r = Empty r | Chunk Strict.ByteString (ByteString m r) | Go (m (ByteString m r)) - . - (Constructors are necessarily hidden in internal modules in both the @Lazy@ and the @Streaming@.) - . - That's it. As a lazy bytestring is implemented internally - by a sort of list of strict bytestring chunks, a streaming bytestring is - simply implemented as a /producer/ or /generator/ of strict bytestring chunks. - Most operations are defined by simply adding a line to what we find in - @Data.ByteString.Lazy@. The only possible simplification would - involve specializing to @IO@, throughout - but this would e.g. block - the use of @ResourceT@ to manage handles and the like, and a number - of other convenient operations like @copy@, which permits one to - apply two operations simultaneously over the length of the byte stream. - . - Something like this alteration of type is of course obvious and mechanical, once the idea of - an effectful bytestring type is contemplated and lazy io is rejected. - Indeed it seems that this is the proper expression of what was - intended by lazy bytestrings to begin with. The documentation, after all, - reads - . - * \"A key feature of lazy ByteStrings is the means to manipulate large or - unbounded streams of data without requiring the entire sequence to be - resident in memory. To take advantage of this you have to write your - functions in a lazy streaming style, e.g. classic pipeline composition. - The default I/O chunk size is 32k, which should be good in most circumstances.\" - . - ... which is very much the idea of this library: the default chunk size for - 'hGetContents' and the like follows @Data.ByteString.Lazy@; operations - like @lines@ and @append@ and so on are tailored not to increase chunk size. - . - The present library is thus if you like nothing but /lazy bytestring done right/. - The authors of @Data.ByteString.Lazy@ must have supposed that - the directly monadic formulation of such their type - would necessarily make things slower. This appears to be a prejudice. - For example, passing a large file of short lines through - this benchmark transformation - . - > Lazy.unlines . map (\bs -> "!" <> Lazy.drop 5 bs) . Lazy.lines - > Streaming.unlines . S.maps (\bs -> chunk "!" >> Streaming.drop 5 bs) . Streaming.lines - . - gives pleasing results like these - . - > $ time ./benchlines lazy >> /dev/null - > real 0m2.097s - > ... - > $ time ./benchlines streaming >> /dev/null - > real 0m1.930s - . - For a more sophisticated operation like - . - > Lazy.intercalate "!\n" . Lazy.lines - > Streaming.intercalate "!\n" . Streaming.lines - . - we get results like these: - . - > time ./benchlines lazy >> /dev/null - > real 0m1.250s - > ... - > time ./benchlines streaming >> /dev/null - > real 0m1.531s - . - The pipes environment would express the latter as - . - > Pipes.intercalates (Pipes.yield "!\n") . view Pipes.lines - . - meaning almost exactly what we mean above, but with results like this - . - > time ./benchlines pipes >> /dev/null - > real 0m6.353s - . - The difference, however, /is emphatically not intrinsic to pipes/; - it is just that - this library depends the @streaming@ library, which is used in place - of @free@ to express the - - splitting and iterated division or "chunking" of byte streams. - . - These concepts belong to the ABCs of streaming; @lines@ is just - a textbook example, and it is of course handled correctly in - @Data.ByteString.Lazy@. - But the concepts are /catastrophically mishandled/ in /all/ streaming io libraries - other than pipes. Already the @enumerator@ and @iteratee@ libraries - were completely defeated by @lines@: - see e.g. the @enumerator@ implementation of - . - This will concatenate strict text forever, if that's what is coming - in. The rot spreads from there. - It is just a fact that in all of the general streaming io - frameworks other than pipes,it becomes torture to express elementary distinctions - that are transparently and immediately contained in any - idea of streaming whatsoever. - . - Though, as was said above, we barely alter signatures in @Data.ByteString.Lazy@ - more than is required by the types, the point of view that emerges - is very much that of - @pipes-bytestring@ and @pipes-group@. In particular - we have these correspondences: - . - > Lazy.splitAt :: Int -> ByteString -> (ByteString, ByteString) - > Streaming.splitAt :: Int -> ByteString m r -> ByteString m (ByteString m r) - > Pipes.splitAt :: Int -> Producer ByteString m r -> Producer ByteString m (Producer ByteString m r) - . - and - . - > Lazy.lines :: ByteString -> [ByteString] - > Streaming.lines :: ByteString m r -> Stream (ByteString m) m r - > Pipes.lines :: Producer ByteString m r -> FreeT (Producer ByteString m) m r - . - where the @Stream@ type expresses the sequencing of @ByteString m _@ layers - with the usual \'free monad\' sequencing. - . - Interoperation with @pipes-bytestring@ uses this isomorphism: - . - > Streaming.ByteString.unfoldrChunks Pipes.next :: Monad m => Producer ByteString m r -> ByteString m r - > Pipes.unfoldr Streaming.ByteString.nextChunk :: Monad m => ByteString m r -> Producer ByteString m r - . - Interoperation with @io-streams@ is thus: - . - > IOStreams.unfoldM Streaming.ByteString.unconsChunk :: ByteString IO () -> IO (InputStream ByteString) - > Streaming.ByteString.reread IOStreams.read :: InputStream ByteString -> ByteString IO () - . - and similarly for other rational streaming io libraries. - . - Problems and questions about the library can be put as issues on - the github page, or mailed to the - . - . - A tutorial module is in the works; - , - for the moment, - is a sequence of simplified implementations of familiar shell utilities. - The same programs are implemented at the end of the excellent - . - It is generally much simpler; in some case simpler than what - you would write with lazy bytestrings. - - is a simple GET request that returns a byte stream. - . +cabal-version: >=1.10 +name: streaming-bytestring +version: 0.1.7 +synopsis: Fast, effectful byte streams. +description: + This library enables fast and safe streaming of byte data, in either @Word8@ or + @Char@ form. It is a core addition to the + and avoids the usual pitfalls of combinbing lazy @ByteString@s with lazy @IO@. + . + We follow the philosophy shared by @streaming@ that "the best API is the one + you already know". Thus this library mirrors the API of the @bytestring@ + library as closely as possible. + . + See the module documentation and the README for more information. +license: BSD3 +license-file: LICENSE +author: michaelt +maintainer: + andrew.thaddeus@gmail.com, what_is_it_to_do_anything@yahoo.com, colin@fosskers.ca -license: BSD3 -license-file: LICENSE -author: michaelt -maintainer: andrew.thaddeus@gmail.com, what_is_it_to_do_anything@yahoo.com -- copyright: -category: Data, Pipes, Streaming -build-type: Simple -extra-source-files: README.md, ChangeLog.md -cabal-version: >=1.10 -stability: Experimental -homepage: https://github.com/haskell-streaming/streaming-bytestring -bug-reports: https://github.com/haskell-streaming/streaming-bytestring/issues -source-repository head - type: git - location: https://github.com/michaelt/streaming-bytestring +category: Data, Pipes, Streaming +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + tests/sample.txt + tests/groupBy.txt +stability: Experimental +homepage: https://github.com/haskell-streaming/streaming-bytestring +bug-reports: + https://github.com/haskell-streaming/streaming-bytestring/issues -library - exposed-modules: Data.ByteString.Streaming - , Data.ByteString.Streaming.Char8 - , Data.ByteString.Streaming.Internal +tested-with: + GHC ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.2 +source-repository head + type: git + location: https://github.com/michaelt/streaming-bytestring +library + default-language: Haskell2010 + hs-source-dirs: lib + ghc-options: -Wall -O2 + exposed-modules: + Data.ByteString.Streaming + Data.ByteString.Streaming.Char8 + Data.ByteString.Streaming.Internal + Streaming.ByteString + Streaming.ByteString.Char8 + Streaming.ByteString.Internal + -- other-modules: - other-extensions: CPP, BangPatterns, ForeignFunctionInterface, DeriveDataTypeable, Unsafe - build-depends: base <5.0 - , bytestring - , deepseq - , exceptions - , mmorph >=1.0 && <1.2 - , mtl >=2.1 && <2.3 - , resourcet - , transformers >=0.3 && <0.6 - , transformers-base - , streaming >= 0.1.4.0 && < 0.3 - if impl(ghc < 7.8) - build-depends: bytestring < 0.10.4.0 - , bytestring-builder + other-extensions: + BangPatterns + CPP + DeriveDataTypeable + ForeignFunctionInterface + Unsafe + + build-depends: + base >=4.8 && <5.0 + , bytestring + , deepseq + , exceptions + , mmorph >=1.0 && <1.2 + , mtl >=2.1 && <2.3 + , resourcet + , streaming >=0.1.4.0 && <0.3 + , transformers >=0.3 && <0.6 + , transformers-base + + if impl(ghc <7.8) + build-depends: + bytestring >=0 && <0.10.4.0 + , bytestring-builder + else - build-depends: bytestring >= 0.10.4 + if impl(ghc <8.0) + build-depends: bytestring >=0.10.4 && <0.11 - if impl(ghc < 8.0) - build-depends: semigroups + else + build-depends: bytestring >=0.10.4 && <0.12 - default-language: Haskell2010 - ghc-options: -O2 + if impl(ghc <8.0) + build-depends: semigroups test-suite test - default-language: - Haskell2010 - type: - exitcode-stdio-1.0 - hs-source-dirs: - tests - main-is: - test.hs + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Test.hs build-depends: - base >= 4 && < 5 - , transformers - , tasty >= 0.11.0.4 - , tasty-smallcheck >= 0.8.1 - , smallcheck >= 1.1.1 + base >=4 && <5 + , bytestring + , resourcet >=1.1 + , smallcheck >=1.1.1 , streaming , streaming-bytestring - , bytestring + , tasty >=0.11.0.4 + , tasty-hunit >=0.9 + , tasty-smallcheck >=0.8.1 + , transformers diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,370 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main ( main ) where + +import Control.Monad.Trans.Resource (runResourceT) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Function (on) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Identity +import qualified Data.IORef as IOR +import qualified Data.List as L +import Data.String (fromString) +import Streaming (Of(..)) +import qualified Streaming as SM +import qualified Streaming.ByteString as Q +import qualified Streaming.ByteString.Char8 as Q8 +import qualified Streaming.ByteString.Internal as QI +import qualified Streaming.Prelude as S +import System.IO +import Test.SmallCheck.Series +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.SmallCheck +import Text.Printf (printf) + +listOf :: Monad m => Series m a -> Series m [a] +listOf a = decDepth $ + pure [] \/ ((:) <$> a <~> listOf a) + +strSeries :: Monad m => Series m String +strSeries = listOf (generate $ const ['a', 'b', '\n']) + +strSeriesCrlf :: Monad m => Series m String +strSeriesCrlf = L.concat <$> listOf (generate $ const ["a", "b", "\r\n"]) + +chunksSeries :: Monad m => Series m [String] +chunksSeries = listOf strSeries + +nats :: Monad m => Series m Int +nats = generate $ \d -> [1..d] + +fromChunks :: [String] -> Q8.ByteStream Identity () +fromChunks = Q8.fromChunks . S.each . map B.pack + +unix2dos :: String -> String +unix2dos = concatMap $ \c -> if c == '\n' then "\r\n" else [c] + +unpackToString :: Q8.ByteStream Identity () -> String +unpackToString = runIdentity . S.toList_ . Q8.unpack + +sLines :: Q8.ByteStream Identity () -> [B.ByteString] +sLines + = runIdentity + . S.toList_ + . S.mapped Q8.toStrict + . Q8.lines + +noNullChunks :: S.Stream (Q8.ByteStream Identity) Identity () -> Bool +noNullChunks = SM.streamFold (\() -> True) runIdentity go + where + go :: Q8.ByteStream Identity Bool -> Bool + go (QI.Empty b) = b + go (QI.Chunk bs sbs) = not (B.null bs) && go sbs + go (QI.Go (Identity sbs)) = go sbs + +handleIsOpen :: Assertion +handleIsOpen = do + h <- openBinaryFile "tests/sample.txt" ReadMode + hIsOpen h >>= assertBool "Expected file handle to be open!" + l <- Q8.length_ $ Q8.hGetContents h + l @?= 73 + hIsOpen h >>= assertBool "Still expected file handle to be open!" + +groupCrash :: Assertion +groupCrash = do + a <- runResourceT . S.sum_ . SM.mapsM Q8.length . Q8.group $ Q8.readFile "tests/groupBy.txt" + a @?= 39925 + b <- runResourceT . S.sum_ . SM.mapsM Q8.length . Q8.groupBy (\_ _ -> True) $ Q8.readFile "tests/groupBy.txt" + b @?= 39925 + +groupCharOrder :: Assertion +groupCharOrder = do + a <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.group $ Q8.fromLazy "1234" + a @?= (["1", "2", "3", "4"] :: [BL.ByteString]) + b <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.group $ Q8.fromLazy "1122" + b @?= (["11", "22"] :: [BL.ByteString]) + +groupByCharOrder :: Assertion +groupByCharOrder = do + -- What about when everything fits into one group? + y <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (\_ _ -> True) $ Q8.fromLazy "abcd" + y @?= ["abcd"] + -- Prove it's not an issue with the Char-based wrapper. + z <- S.toList_ . SM.mapsM Q.toLazy $ Q.groupBy (\a b -> a - 1 == b) $ Q.fromLazy "98764321" + z @?= ["98", "76", "43", "21"] + -- Char-based variant + a <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (\a b -> succ a == b) $ Q8.fromLazy "12346789" + a @?= ["12", "34", "67", "89"] + b <- S.toList_ . SM.mapsM Q8.toLazy $ Q8.groupBy (on (==) (== '5')) $ Q8.fromLazy "5678" + b @?= ["5", "678"] + +goodFindIndex :: Assertion +goodFindIndex = do + assertBool "Expected the length of the string" $ QI.findIndexOrEnd (const False) "1234" == 4 + assertBool "Expected 0" $ QI.findIndexOrEnd (const True) "1234" == 0 + +firstI :: Assertion +firstI = do + l <- runResourceT + . S.length_ -- IO Int + . S.filter (== 'i') + . S.concat -- Stream (Of Char) IO () + . S.mapped Q8.head -- Stream (Of (Maybe Char)) IO () + . Q8.denull -- Stream (ByteStream IO) IO () + . Q8.lines -- Stream (ByteStream IO) IO () + $ Q8.readFile "tests/groupBy.txt" -- ByteStream IO () + l @?= 57 + +readIntCases :: Assertion +readIntCases = do + let imax = maxBound :: Int + imin = minBound :: Int + imax1 = fromIntegral imax + 1 :: Integer + imax10 = fromIntegral imax + 10 :: Integer + imin1 = fromIntegral imin - 1 :: Integer + imin10 = fromIntegral imin - 10 :: Integer + smax = B.pack $ show imax + smin = B.pack $ show imin + smax1 = B.pack $ show imax1 + smax10 = B.pack $ show imax10 + smin1 = B.pack $ show imin1 + smin10 = B.pack $ show imin10 + maxfill = QI.defaultChunkSize + cnt <- IOR.newIORef 0 -- number of effects in stream. + -- Empty input + IOR.writeIORef cnt 1 + res <- Q8.readInt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Chunk "" + $ QI.Empty 0 + check cnt res Nothing ("" :> 0) + -- Basic unsigned + IOR.writeIORef cnt 1 + res <- Q8.readInt + $ QI.Chunk "123" + $ addEffect cnt + $ QI.Empty 1 + check cnt res (Just 123) ("" :> 1) + -- Basic negative + IOR.writeIORef cnt 2 + res <- Q8.readInt + $ QI.Chunk "-123" + $ addEffect cnt + $ QI.Chunk "456+789" + $ addEffect cnt + $ QI.Empty 2 + check cnt res (Just (-123456)) ("+789" :> 2) + -- minBound with leading whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smin) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smin) + $ addEffect cnt + $ QI.Chunk "-42" + $ addEffect cnt + $ QI.Empty 3 + check cnt res (Just imin) ("-42" :> 3) + -- maxBound with leading whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smax) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smax) + $ addEffect cnt + $ QI.Chunk "+42" + $ addEffect cnt + $ QI.Empty 4 + check cnt res (Just imax) ("+42" :> 4) + -- minbound-1 with whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smin1) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smin1) + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 5 + check cnt res Nothing (smin1 :> 5) + -- maxbound+1 with whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smax1) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smax1) + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 6 + check cnt res Nothing (smax1 :> 6) + -- maxBound with explicit plus sign + IOR.writeIORef cnt 2 + res <- readIntSkip + $ QI.Chunk " +" + $ addEffect cnt + $ QI.Chunk smax + $ QI.Chunk "tail" + $ addEffect cnt + $ QI.Empty 7 + check cnt res (Just imax) ("tail" :> 7) + -- maxBound with almost excessive leading whitepace/zeros + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk (B.replicate (maxfill-1) ' ') + $ addEffect cnt + $ QI.Chunk " +" + $ QI.Chunk (B.replicate (maxfill-1) '0') + $ addEffect cnt + $ QI.Chunk ("000000" `B.append` smax) + $ addEffect cnt + $ QI.Chunk "tail" + $ addEffect cnt + $ QI.Empty 8 + check cnt res (Just imax) ("tail" :> 8) + -- (Exactly) too much leading whitespace + IOR.writeIORef cnt 3 + res <- readIntSkip + $ QI.Chunk (B.replicate maxfill ' ') + $ addEffect cnt + $ QI.Chunk " 1" + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 9 + check cnt res Nothing (" 1" :> 9) + -- (Exactly) too many leading zeros + IOR.writeIORef cnt 3 + res <- readIntSkip + $ QI.Chunk (B.replicate maxfill '0') + $ addEffect cnt + $ QI.Chunk "1" + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 10 + check cnt res Nothing (B.replicate maxfill '0' `B.append` "1" :> 10) + -- Bare plus + IOR.writeIORef cnt 1 + res <- readIntSkip + $ QI.Chunk " +" + $ addEffect cnt + $ QI.Chunk "foo" + $ QI.Empty 11 + check cnt res Nothing ("+foo" :> 11) + -- Bare minus + IOR.writeIORef cnt 1 + res <- readIntSkip + $ QI.Chunk " -" + $ addEffect cnt + $ QI.Chunk " bar" + $ QI.Empty 12 + check cnt res Nothing ("- bar" :> 12) + -- + IOR.writeIORef cnt 1 + let msg = " nothing to see here move along " + res <- Q8.readInt + $ QI.Chunk msg + $ addEffect cnt + $ QI.Empty 13 + check cnt res Nothing (msg :> 13) + -- whitespace-only input + IOR.writeIORef cnt 1 + res <- readIntSkip + $ QI.Chunk " " + $ addEffect cnt + $ QI.Chunk "\n" + $ QI.Empty 14 + check cnt res Nothing ("" :> 14) + -- maxbound+10 with whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smax10) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smax10) + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 15 + check cnt res Nothing (smax10 :> 15) + -- minbound-10 with whitespace + IOR.writeIORef cnt 4 + res <- readIntSkip + $ QI.Chunk " \t\n\v\f\r\xa0" + $ addEffect cnt + $ QI.Chunk (B.take 4 smin10) + $ addEffect cnt + $ QI.Chunk (B.drop 4 smin10) + $ addEffect cnt + $ QI.Chunk "" + $ addEffect cnt + $ QI.Empty 16 + check cnt res Nothing (smin10 :> 16) + where + -- Count down to zero from initial value + readIntSkip = Q8.readInt . Q8.skipSomeWS + addEffect cnt str = QI.Go $ const str <$> IOR.modifyIORef' cnt pred + check :: IOR.IORef Int + -> Compose (Of (Maybe Int)) (QI.ByteStream IO) Int + -> Maybe Int + -> Of B.ByteString Int + -> Assertion + check cnt (Compose (gotInt :> str)) wantInt (wantStr :> wantR ) = do + ( gotStr :> gotR ) <- Q.toStrict str + c <- IOR.readIORef cnt + assertBool ("Correct readInt effects " ++ show wantR) $ c == 0 + assertBool ("Correct readInt value " ++ show wantR ++ ": " ++ show gotInt) $ gotInt == wantInt + assertBool ("Correct readInt tail " ++ show wantR ++ ": " ++ show gotStr) $ gotStr == wantStr + assertBool ("Correct readInt residue " ++ show wantR ++ ": " ++ show gotR) $ gotR == wantR + +main :: IO () +main = defaultMain $ testGroup "Tests" + [ testGroup "Property Tests" + [ testProperty "Streaming.ByteString.Char8.lines is equivalent to Prelude.lines" $ over chunksSeries $ \chunks -> + -- This only makes sure that the streaming-bytestring lines function + -- matches the Prelude lines function when no carriage returns + -- are present. They are not expected to have the same behavior + -- with dos-style line termination. + let expected = lines $ concat chunks + got = (map B.unpack . sLines . fromChunks) chunks + in + if expected == got + then Right ("" :: String) + else Left (printf "Expected %s; got %s" (show expected) (show got) :: String) + , testProperty "lines recognizes DOS line endings" $ over strSeries $ \str -> + sLines (Q8.string $ unix2dos str) == sLines (Q8.string str) + , testProperty "lines recognizes DOS line endings with tiny chunks" $ over strSeries $ \str -> + sLines (mapM_ Q8.singleton $ unix2dos str) == sLines (mapM_ Q8.singleton str) + , testProperty "lineSplit does not create null chunks (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> + noNullChunks (Q8.lineSplit n (fromString str)) + , testProperty "lineSplit does not create null chunks (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> + noNullChunks (Q8.lineSplit n (fromString str)) + , testProperty "concat after lineSplit round trips (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> + unpackToString (Q8.concat (Q8.lineSplit n (fromString str))) == str + , testProperty "concat after lineSplit round trips (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> + unpackToString (Q8.concat (Q8.lineSplit n (fromString str))) == str + ] + , testGroup "Unit Tests" + [ testCase "hGetContents: Handle stays open" handleIsOpen + , testCase "group(By): Don't crash" groupCrash + , testCase "group: Char order" groupCharOrder + , testCase "groupBy: Char order" groupByCharOrder + , testCase "findIndexOrEnd" goodFindIndex + , testCase "Stream Interop" firstI + , testCase "readInt" readIntCases + ] + ] diff --git a/tests/groupBy.txt b/tests/groupBy.txt new file mode 100644 --- /dev/null +++ b/tests/groupBy.txt @@ -0,0 +1,572 @@ +This is a test file, larger than 32kb, which is designed to trigger a (hopefully +now fixed) bug in `group` and `groupBy`. Well, here goes. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. + +Nullam eu ante vel est convallis dignissim. Fusce suscipit, wisi nec facilisis +facilisis, est dui fermentum leo, quis tempor ligula erat quis odio. Nunc porta +vulputate tellus. Nunc rutrum turpis sed pede. Sed bibendum. Aliquam posuere. +Nunc aliquet, augue nec adipiscing interdum, lacus tellus malesuada massa, quis +varius mi purus non odio. Pellentesque condimentum, magna ut suscipit hendrerit, +ipsum augue ornare nulla, non luctus diam neque sit amet urna. Curabitur +vulputate vestibulum lorem. Fusce sagittis, libero non molestie mollis, magna +orci ultrices dolor, at vulputate neque nulla lacinia eros. Sed id ligula quis +est convallis tempor. Curabitur lacinia pulvinar nibh. Nam a sapien. diff --git a/tests/sample.txt b/tests/sample.txt new file mode 100644 --- /dev/null +++ b/tests/sample.txt @@ -0,0 +1,7 @@ +This is +a file +with some text +in it. +Will everything +stream as +expected? diff --git a/tests/test.hs b/tests/test.hs deleted file mode 100644 --- a/tests/test.hs +++ /dev/null @@ -1,83 +0,0 @@ -import Test.Tasty -import Test.Tasty.SmallCheck -import Test.SmallCheck.Series - -import Control.Applicative -import Data.Functor.Identity -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.ByteString.Streaming.Char8 as SBS8 -import qualified Data.ByteString.Streaming.Internal as SBSI -import Text.Printf -import qualified Streaming.Prelude as S -import qualified Streaming as SM -import Data.String (fromString) -import Data.Functor.Identity -import qualified Data.List as L - -listOf :: Monad m => Series m a -> Series m [a] -listOf a = decDepth $ - pure [] \/ ((:) <$> a <~> listOf a) - -strSeries :: Monad m => Series m String -strSeries = listOf (generate $ const ['a', 'b', '\n']) - -strSeriesCrlf :: Monad m => Series m String -strSeriesCrlf = fmap L.concat $ listOf (generate $ const ["a", "b", "\r\n"]) - -chunksSeries :: Monad m => Series m [String] -chunksSeries = listOf strSeries - -nats :: Monad m => Series m Int -nats = generate $ \d -> [1..d] - -fromChunks :: [String] -> SBS8.ByteString Identity () -fromChunks = SBS8.fromChunks . S.each . map BS8.pack - -unix2dos :: String -> String -unix2dos = concatMap $ \c -> if c == '\n' then "\r\n" else [c] - -unpackToString :: SBS8.ByteString Identity () -> String -unpackToString = runIdentity . S.toList_ . SBS8.unpack - -s_lines :: SBS8.ByteString Identity () -> [BS8.ByteString] -s_lines - = runIdentity - . S.toList_ - . S.mapped SBS8.toStrict - . SBS8.lines - -noNullChunks :: S.Stream (SBS8.ByteString Identity) Identity () -> Bool -noNullChunks = SM.streamFold (\() -> True) runIdentity go - where - go :: SBS8.ByteString Identity Bool -> Bool - go (SBSI.Empty b) = b - go (SBSI.Chunk bs sbs) = not (BS8.null bs) && go sbs - go (SBSI.Go (Identity sbs)) = go sbs - -main = defaultMain $ testGroup "Tests" - [ testGroup "lines" $ - [ testProperty "Data.ByteString.Streaming.Char8.lines is equivalent to Prelude.lines" $ over chunksSeries $ \chunks -> - -- This only makes sure that the streaming-bytestring lines function - -- matches the Prelude lines function when no carriage returns - -- are present. They are not expected to have the same behavior - -- with dos-style line termination. - let expected = lines $ concat chunks - got = (map BS8.unpack . s_lines . fromChunks) chunks - in - if expected == got - then Right "" - else Left (printf "Expected %s; got %s" (show expected) (show got) :: String) - , testProperty "lines recognizes DOS line endings" $ over strSeries $ \str -> - s_lines (SBS8.string $ unix2dos str) == s_lines (SBS8.string str) - , testProperty "lines recognizes DOS line endings with tiny chunks" $ over strSeries $ \str -> - s_lines (mapM_ SBS8.singleton $ unix2dos str) == s_lines (mapM_ SBS8.singleton str) - , testProperty "lineSplit does not create null chunks (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> - noNullChunks (SBS8.lineSplit n (fromString str)) - , testProperty "lineSplit does not create null chunks (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> - noNullChunks (SBS8.lineSplit n (fromString str)) - , testProperty "concat after lineSplit round trips (LF)" $ over ((,) <$> nats <~> strSeries) $ \(n,str) -> - unpackToString (SBS8.concat (SBS8.lineSplit n (fromString str))) == str - , testProperty "concat after lineSplit round trips (CRLF)" $ over ((,) <$> nats <~> strSeriesCrlf) $ \(n,str) -> - unpackToString (SBS8.concat (SBS8.lineSplit n (fromString str))) == str - ] - ]