diff --git a/Data/ByteString/Streaming.hs b/Data/ByteString/Streaming.hs --- a/Data/ByteString/Streaming.hs +++ b/Data/ByteString/Streaming.hs @@ -14,11 +14,15 @@ -- 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. +-- 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 @@ -137,8 +141,9 @@ , length , length_ , null - , nulls , null_ + , nulls + , testNull , count , count_ -- * I\/O with 'ByteString's @@ -399,8 +404,31 @@ -- --------------------------------------------------------------------- -- 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. + the monad of the effects. >>> Q.null "one\ntwo\three\nfour\nfive\n" False @@ -418,6 +446,14 @@ {-# 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. -} @@ -425,28 +461,8 @@ denull = hoist (run . maps effects) . separate . mapped nulls {-#INLINE denull #-} -{- | /O(1)/ 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 #-} - {-| /O1/ Distinguish empty from non-empty lines, while maintaining streaming; the empty ByteStrings are on the right @@ -542,9 +558,11 @@ -- | /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 _) = return $ S.unsafeHead c +head_ (Chunk c bs) = if S.null c + then head_ bs + else return $ S.unsafeHead c head_ (Go m) = m >>= head_ -{-# INLINE 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) @@ -555,7 +573,7 @@ r <- SP.effects $ toChunks rest return $! (Just w) :> r head (Go m) = m >>= head -{-# INLINE head #-} +{-# INLINABLE head #-} -- | /O(1)/ Extract the head and tail of a 'ByteString', or 'Nothing' -- if it is empty diff --git a/Data/ByteString/Streaming/Char8.hs b/Data/ByteString/Streaming/Char8.hs --- a/Data/ByteString/Streaming/Char8.hs +++ b/Data/ByteString/Streaming/Char8.hs @@ -1,7 +1,11 @@ {-# 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. +-- | 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 ( @@ -46,6 +50,8 @@ , 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 @@ -68,6 +74,7 @@ , split -- split :: Monad m => Char -> ByteString m r -> Stream (ByteString m) m r , lines , words + , lineSplit , denull -- ** Special folds @@ -91,6 +98,7 @@ , 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 @@ -99,7 +107,6 @@ , length_ , count , count_ - , null_ , readInt -- * I\/O with 'ByteString's @@ -174,7 +181,7 @@ fromChunks, toChunks, fromStrict, toStrict, toStrict_, concat, distribute, effects, drained, mwrap, toStreamingByteStringWith, toStreamingByteString, toBuilder, concatBuilders, - empty, null, nulls, null_, length, length_, append, cycle, + 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, @@ -190,6 +197,7 @@ 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 @@ -510,16 +518,22 @@ Go m -> Effect $ liftM loop1 m Chunk c cs | B.null c -> loop1 cs - | otherwise -> Step (loop2 text) - loop2 :: ByteString m r -> ByteString m (Stream (ByteString m) m r) - loop2 text = + | 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 -> Empty (Return r) - Go m -> Go $ liftM loop2 m + 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 -> Chunk c (loop2 cs) - Just i -> + 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 @@ -528,7 +542,10 @@ if B.length c > i+1 then Chunk (B.drop (i+1) c) cs else cs - in Chunk (B.unsafeTake prefixLength c) (Empty (loop1 rest)) + 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. @@ -581,7 +598,76 @@ {-# 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 diff --git a/Data/ByteString/Streaming/Internal.hs b/Data/ByteString/Streaming/Internal.hs --- a/Data/ByteString/Streaming/Internal.hs +++ b/Data/ByteString/Streaming/Internal.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, BangPatterns, RankNTypes, GADTs #-} {-# LANGUAGE UnliftedFFITypes, MagicHash, UnboxedTuples #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} --- for resourcet etc. + module Data.ByteString.Streaming.Internal ( ByteString (..) , consChunk -- :: S.ByteString -> ByteString m r -> ByteString m r @@ -32,6 +32,7 @@ , reread , inlinePerformIO , unsafeLast + , unsafeInit , copy -- * ResourceT help @@ -73,6 +74,7 @@ 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. -- @@ -333,12 +335,18 @@ 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 diff --git a/streaming-bytestring.cabal b/streaming-bytestring.cabal --- a/streaming-bytestring.cabal +++ b/streaming-bytestring.cabal @@ -1,12 +1,22 @@ name: streaming-bytestring -version: 0.1.4.6 +version: 0.1.5 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. + 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@. . - The implementation follows the + 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 @@ -24,7 +34,11 @@ 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@. + @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. @@ -42,7 +56,7 @@ '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 nothing but /lazy bytestring done right/. + 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. @@ -82,7 +96,7 @@ > time ./benchlines pipes >> /dev/null > real 0m6.353s . - The difference, however, is emphatically not intrinsic to pipes; + 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 @@ -155,15 +169,15 @@ license: BSD3 license-file: LICENSE author: michaelt -maintainer: what_is_it_to_do_anything@yahoo.com +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 cabal-version: >=1.10 stability: Experimental -homepage: https://github.com/michaelt/streaming-bytestring -bug-reports: https://github.com/michaelt/streaming-bytestring/issues +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 @@ -184,7 +198,7 @@ , mmorph >=1.0 && <1.2 , transformers >=0.3 && <0.6 , transformers-base - , streaming >= 0.1.4.0 && < 0.1.4.8 + , streaming >= 0.1.4.0 && < 0.3 , resourcet , exceptions if impl(ghc < 7.8) diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -6,8 +6,13 @@ 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 $ @@ -16,15 +21,24 @@ 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 @@ -32,9 +46,21 @@ . 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 @@ -43,5 +69,15 @@ 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 ] ]