diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +# Version 1.3.0.0 + - As long promised, removed the direct use of the `blaze-builder` package in + favor of the new `bytestring-builder` transitional package (to be replaced + by bytestring's native builder once it is mature enough). + - Added a new convenience function, a flipped version of `write`: + ```haskell +writeTo :: OutputStream a -> Maybe a -> IO () + ``` + # Version 1.2.1.3 - Dependency bump for primitive 0.6. diff --git a/io-streams.cabal b/io-streams.cabal --- a/io-streams.cabal +++ b/io-streams.cabal @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.2.1.3 +Version: 1.3.0.0 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams @@ -7,8 +7,7 @@ Maintainer: Gregory Collins Cabal-version: >= 1.10 Synopsis: Simple, composable, and easy-to-use stream I/O -Tested-With: GHC==7.8.4, GHC==7.8.2, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, - GHC==7.4.1, GHC==7.2.2, GHC==7.0.4 +Tested-With: GHC==7.8.4, GHC==7.8.3, GHC==7.6.3, GHC==7.4.2 Bug-Reports: https://github.com/snapframework/io-streams/issues Description: /Overview/ @@ -118,18 +117,18 @@ System.IO.Streams.Internal.Network, System.IO.Streams.Internal.Search - Build-depends: base >= 4 && <5, - attoparsec >= 0.10 && <0.13, - blaze-builder >= 0.3.1 && <0.4, - bytestring >= 0.9 && <0.11, - network >= 2.3 && <2.7, - primitive >= 0.2 && <0.7, - process >= 1.1 && <1.3, - text >= 0.10 && <1.3, - time >= 1.2 && <1.6, - transformers >= 0.2 && <0.5, - vector >= 0.7 && <0.11, - zlib-bindings >= 0.1 && <0.2 + Build-depends: base >= 4 && <5, + attoparsec >= 0.10 && <0.13, + bytestring >= 0.9 && <0.11, + bytestring-builder >= 0.10 && <0.11, + network >= 2.3 && <2.7, + primitive >= 0.2 && <0.7, + process >= 1.1 && <1.3, + text >= 0.10 && <1.3, + time >= 1.2 && <1.6, + transformers >= 0.2 && <0.5, + vector >= 0.7 && <0.11, + zlib-bindings >= 0.1 && <0.2 if impl(ghc >= 7.2) other-extensions: Trustworthy @@ -199,23 +198,22 @@ if !os(windows) && !flag(NoInteractiveTests) cpp-options: -DENABLE_PROCESS_TESTS - - Build-depends: base >= 4 && <5, - attoparsec >= 0.10 && <0.13, - blaze-builder >= 0.3.1 && <0.4, - bytestring >= 0.9 && <0.11, - deepseq >= 1.2 && <1.5, - directory >= 1.1 && <2, - filepath >= 1.2 && <2, - mtl >= 2 && <3, - network >= 2.3 && <2.7, - primitive >= 0.2 && <0.7, - process >= 1 && <1.3, - text >= 0.10 && <1.3, - time >= 1.2 && <1.6, - transformers >= 0.2 && <0.5, - vector >= 0.7 && <0.11, - zlib-bindings >= 0.1 && <0.2, + Build-depends: base >= 4 && <5, + attoparsec >= 0.10 && <0.13, + bytestring >= 0.9 && <0.11, + bytestring-builder >= 0.10 && <0.11, + deepseq >= 1.2 && <1.5, + directory >= 1.1 && <2, + filepath >= 1.2 && <2, + mtl >= 2 && <3, + network >= 2.3 && <2.7, + primitive >= 0.2 && <0.7, + process >= 1 && <1.3, + text >= 0.10 && <1.3, + time >= 1.2 && <1.6, + transformers >= 0.2 && <0.5, + vector >= 0.7 && <0.11, + zlib-bindings >= 0.1 && <0.2, HUnit >= 1.2 && <2, QuickCheck >= 2.3.0.2 && <3, diff --git a/src/System/IO/Streams/Builder.hs b/src/System/IO/Streams/Builder.hs --- a/src/System/IO/Streams/Builder.hs +++ b/src/System/IO/Streams/Builder.hs @@ -1,18 +1,20 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Buffering for output streams based on bytestring builders. -- -- Buffering an output stream can often improve throughput by reducing the --- number of system calls made through the file descriptor. The @blaze-builder@ --- package provides an efficient set of primitives for serializing values --- directly to an output buffer. +-- number of system calls made through the file descriptor. The @bytestring@ +-- package provides an efficient monoidal datatype used for serializing values +-- directly to an output buffer, called a 'Builder', originally implemented in +-- the @blaze-builder@ package by Simon Meier. When compiling with @bytestring@ +-- versions older than 0.10.4, (i.e. GHC <= 7.6) users must depend on the +-- @bytestring-builder@ library to get the new builder implementation. Since we +-- try to maintain compatibility with the last three GHC versions, the +-- dependency on @bytestring-builder@ can be dropped after the release of GHC +-- 7.12. -- --- (/N.B./: most of the @blaze-builder@ package has been moved into --- @bytestring@ in versions \>= 0.10; once two or three Haskell Platform --- editions have been released that contain @bytestring@ 0.10.2 or higher, the --- dependency on @blaze-builder@ will be dropped in favor of the native support --- for 'Builder' contained in the @bytestring@ package.) -- -- /Using this module/ -- @@ -27,16 +29,16 @@ -- @ -- do -- newStream <- Streams.'builderStream' someOutputStream --- Streams.'write' ('Just' $ 'Blaze.ByteString.Builder.fromByteString' \"hello\") newStream +-- Streams.'write' ('Just' $ 'Data.ByteString.Builder.byteString' \"hello\") newStream -- .... -- @ -- -- --- You can flush the output buffer using 'Blaze.ByteString.Builder.flush': +-- You can flush the output buffer using 'Data.ByteString.Builder.Extra.flush': -- -- @ -- .... --- Streams.'write' ('Just' 'Blaze.ByteString.Builder.flush') newStream +-- Streams.'write' ('Just' 'Data.ByteString.Builder.Extra.flush') newStream -- .... -- @ -- @@ -53,7 +55,7 @@ -- example = do -- let l1 = 'Data.List.intersperse' \" \" [\"the\", \"quick\", \"brown\", \"fox\"] -- let l2 = 'Data.List.intersperse' \" \" [\"jumped\", \"over\", \"the\"] --- let l = map 'Blaze.ByteString.Builder.fromByteString' l1 ++ ['Blaze.ByteString.Builder.flush'] ++ map 'Blaze.ByteString.Builder.fromByteString' l2 +-- let l = map 'Data.ByteString.Builder.byteString' l1 ++ ['Data.ByteString.Builder.Extra.flush'] ++ map 'Data.ByteString.Builder.byteString' l2 -- is \<- Streams.'System.IO.Streams.fromList' l -- (os0, grab) \<- Streams.'System.IO.Streams.listOutputStream' -- os \<- Streams.'builderStream' os0 @@ -66,23 +68,83 @@ module System.IO.Streams.Builder ( -- * Blaze builder conversion builderStream + , builderStreamWithBufferSize , unsafeBuilderStream - , builderStreamWith ) where ------------------------------------------------------------------------------ -import Control.Monad (when) -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as S -import Data.IORef (newIORef, readIORef, writeIORef) +import Control.Monad (when) +import Data.ByteString.Builder.Internal (Buffer (..), BufferRange (..), Builder, byteStringFromBuffer, defaultChunkSize, fillWithBuildStep, newBuffer, runBuilder) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as S +import Data.IORef (newIORef, readIORef, writeIORef) + ------------------------------------------------------------------------------ -import Blaze.ByteString.Builder.Internal (defaultBufferSize) -import Blaze.ByteString.Builder.Internal.Buffer (Buffer, BufferAllocStrategy, allNewBuffersStrategy, execBuildStep, reuseBufferStrategy, unsafeFreezeBuffer, unsafeFreezeNonEmptyBuffer, updateEndOfSlice) -import Blaze.ByteString.Builder.Internal.Types (BufRange (..), BuildSignal (..), Builder (..), buildStep) -import System.IO.Streams.Internal (OutputStream, makeOutputStream, write) +import System.IO.Streams.Internal (OutputStream, makeOutputStream, write, writeTo) ------------------------------------------------------------------------------ +builderStreamWithBufferFunc :: IO Buffer + -> OutputStream ByteString + -> IO (OutputStream Builder) +builderStreamWithBufferFunc mkNewBuf os = do + ref <- newIORef Nothing + makeOutputStream $ chunk ref + where + chunk ref Nothing = do + mbuf <- readIORef ref + case mbuf of + -- If we existing buffer leftovers, write them to the output. + Nothing -> return $! () + Just buf -> writeBuf buf + write Nothing os + chunk ref (Just builder) = runStep ref $ runBuilder builder + + getBuf ref = readIORef ref >>= maybe mkNewBuf return + + bumpBuf (Buffer fp (BufferRange !_ endBuf)) endPtr = + Buffer fp (BufferRange endPtr endBuf) + + updateBuf ref buf endPtr = writeIORef ref $! Just $! bumpBuf buf endPtr + + writeBuf buf = do + let bs = byteStringFromBuffer buf + when (not . S.null $ bs) $ writeTo os $! Just bs + + bufRange (Buffer _ rng) = rng + + runStep ref step = do + buf <- getBuf ref + fillWithBuildStep step (cDone buf) (cFull buf) (cInsert buf) + (bufRange buf) + where + cDone buf endPtr !() = updateBuf ref buf endPtr + cFull buf !endPtr !_ newStep = do + writeBuf $! bumpBuf buf endPtr + writeIORef ref Nothing + runStep ref newStep + cInsert buf !endPtr !bs newStep = do + writeBuf $! bumpBuf buf endPtr + writeIORef ref Nothing + writeTo os $! Just bs + runStep ref newStep + + +------------------------------------------------------------------------------ +-- | Converts a 'ByteString' sink into a 'Builder' sink, using the supplied +-- buffer size. +-- +-- Note that if the generated builder receives a +-- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string +-- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output +-- buffers are to be flushed. +-- +-- /Since: 1.3.0.0./ +builderStreamWithBufferSize :: Int -> OutputStream ByteString -> IO (OutputStream Builder) +builderStreamWithBufferSize bufsiz = builderStreamWithBufferFunc (newBuffer bufsiz) + + +------------------------------------------------------------------------------ -- | Converts a 'ByteString' sink into a 'Builder' sink. -- -- Note that if the generated builder receives a @@ -91,7 +153,7 @@ -- buffers are to be flushed. -- builderStream :: OutputStream ByteString -> IO (OutputStream Builder) -builderStream = builderStreamWith (allNewBuffersStrategy defaultBufferSize) +builderStream = builderStreamWithBufferSize defaultChunkSize ------------------------------------------------------------------------------ @@ -108,69 +170,11 @@ -- 'Data.ByteString.copy' to ensure that you have a fresh copy of the -- underlying string. -- --- You can create a Buffer with --- 'Blaze.ByteString.Builder.Internal.Buffer.allocBuffer'. --- +-- You can create a Buffer with 'Data.ByteString.Builder.Internal.newBuffer'. -- unsafeBuilderStream :: IO Buffer -> OutputStream ByteString -> IO (OutputStream Builder) -unsafeBuilderStream = builderStreamWith . reuseBufferStrategy - - ------------------------------------------------------------------------------- --- | A customized version of 'builderStream', using the specified --- 'BufferAllocStrategy'. -builderStreamWith :: BufferAllocStrategy - -> OutputStream ByteString - -> IO (OutputStream Builder) -builderStreamWith (ioBuf0, nextBuf) os = do - bufRef <- newIORef ioBuf0 - makeOutputStream $ sink bufRef - where - sink bufRef m = do - buf <- readIORef bufRef - maybe (eof buf) (chunk buf) m - where - eof ioBuf = do - buf <- ioBuf - case unsafeFreezeNonEmptyBuffer buf of - Nothing -> write Nothing os - x@(Just s) -> do - when (not $ S.null s) $ write x os - write Nothing os - - chunk ioBuf c = feed bufRef (unBuilder c (buildStep finalStep)) ioBuf - - finalStep !(BufRange pf _) = return $! Done pf $! () - - feed bufRef bStep ioBuf = do - !buf <- ioBuf - signal <- execBuildStep bStep buf - - case signal of - Done op' _ -> - writeIORef bufRef $ (return (updateEndOfSlice buf op')) - - BufferFull minSize op' bStep' -> do - let buf' = updateEndOfSlice buf op' - {-# INLINE cont #-} - cont = do - ioBuf' <- nextBuf minSize buf' - feed bufRef bStep' ioBuf' - - write (Just $! unsafeFreezeBuffer buf') os - cont - - InsertByteString op' bs bStep' -> do - let buf' = updateEndOfSlice buf op' - - case unsafeFreezeNonEmptyBuffer buf' of - Nothing -> return $! () - x -> write x os - - -- empty string here notifies downstream of flush - write (Just bs) os - - ioBuf' <- nextBuf 1 buf' - feed bufRef bStep' ioBuf' +unsafeBuilderStream mkBuf os = do + buf <- mkBuf + builderStreamWithBufferFunc (return buf) os diff --git a/src/System/IO/Streams/Core.hs b/src/System/IO/Streams/Core.hs --- a/src/System/IO/Streams/Core.hs +++ b/src/System/IO/Streams/Core.hs @@ -17,6 +17,7 @@ , unRead , peek , write + , writeTo , atEOF -- * Connecting streams together diff --git a/src/System/IO/Streams/Internal.hs b/src/System/IO/Streams/Internal.hs --- a/src/System/IO/Streams/Internal.hs +++ b/src/System/IO/Streams/Internal.hs @@ -27,6 +27,7 @@ , unRead , peek , write + , writeTo , atEOF -- * Building streams @@ -146,6 +147,15 @@ write :: Maybe a -> OutputStream a -> IO () write = flip _write {-# INLINE write #-} + + +------------------------------------------------------------------------------ +-- | Flipped version of 'write'. +-- +-- /Since: 1.3.0.0./ +writeTo :: OutputStream a -> Maybe a -> IO () +writeTo = _write +{-# INLINE writeTo #-} ------------------------------------------------------------------------------ diff --git a/src/System/IO/Streams/Zlib.hs b/src/System/IO/Streams/Zlib.hs --- a/src/System/IO/Streams/Zlib.hs +++ b/src/System/IO/Streams/Zlib.hs @@ -18,18 +18,18 @@ ) where ------------------------------------------------------------------------------ -import Data.ByteString (ByteString) -import qualified Data.ByteString as S -import Data.IORef (newIORef, readIORef, writeIORef) -import Prelude hiding (read) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import Data.IORef (newIORef, readIORef, writeIORef) +import Prelude hiding (read) ------------------------------------------------------------------------------ -import Blaze.ByteString.Builder (fromByteString) -import Blaze.ByteString.Builder.Internal (Builder, defaultBufferSize, flush) -import Blaze.ByteString.Builder.Internal.Buffer (allocBuffer) -import Codec.Zlib (Deflate, Inflate, Popper, WindowBits (..), feedDeflate, feedInflate, finishDeflate, finishInflate, flushDeflate, flushInflate, initDeflate, initInflate) +import Codec.Zlib (Deflate, Inflate, Popper, WindowBits (..), feedDeflate, feedInflate, finishDeflate, finishInflate, flushDeflate, flushInflate, initDeflate, initInflate) +import Data.ByteString.Builder (Builder, byteString) +import Data.ByteString.Builder.Extra (defaultChunkSize, flush) +import Data.ByteString.Builder.Internal (newBuffer) ------------------------------------------------------------------------------ -import System.IO.Streams.Builder (unsafeBuilderStream) -import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write) +import System.IO.Streams.Builder (unsafeBuilderStream) +import System.IO.Streams.Internal (InputStream, OutputStream, makeInputStream, makeOutputStream, read, write) ------------------------------------------------------------------------------ @@ -105,13 +105,13 @@ -- we can use unsafeBuilderStream here because zlib is going to consume the -- stream - unsafeBuilderStream (allocBuffer defaultBufferSize) zippedStr + unsafeBuilderStream (newBuffer defaultChunkSize) zippedStr where bytestringStream x = write (fmap cvt x) stream cvt s | S.null s = flush - | otherwise = fromByteString s + | otherwise = byteString s ------------------------------------------------------------------------------ diff --git a/test/System/IO/Streams/Tests/Builder.hs b/test/System/IO/Streams/Tests/Builder.hs --- a/test/System/IO/Streams/Tests/Builder.hs +++ b/test/System/IO/Streams/Tests/Builder.hs @@ -3,17 +3,19 @@ module System.IO.Streams.Tests.Builder (tests) where ------------------------------------------------------------------------------ -import Blaze.ByteString.Builder -import Blaze.ByteString.Builder.Internal.Buffer import Control.Monad -import qualified Data.ByteString.Char8 as S +import Data.ByteString.Builder (byteString, toLazyByteString) +import Data.ByteString.Builder.Extra (flush) +import Data.ByteString.Builder.Internal (newBuffer) +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L import Data.List import Data.Monoid -import System.IO.Streams hiding (fromByteString, intersperse, map, take) -import qualified System.IO.Streams as Streams +import System.IO.Streams hiding (intersperse, map, take) +import qualified System.IO.Streams as Streams import Test.Framework import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) +import Test.HUnit hiding (Test) ------------------------------------------------------------------------------ tests :: [Test] @@ -31,7 +33,7 @@ testBuilderStream = testCase "builder/builderStream" $ do let l1 = intersperse " " ["the", "quick", "brown", "fox"] let l2 = intersperse " " ["jumped", "over", "the"] - let l = map fromByteString l1 ++ [flush] ++ map fromByteString l2 + let l = map byteString l1 ++ [flush] ++ map byteString l2 is <- fromList l (os0, grab) <- listOutputStream @@ -53,9 +55,9 @@ (os0, grab) <- Streams.listOutputStream os <- Streams.builderStream os0 is0 <- Streams.fromList ["Hello, world!\n"] - >>= Streams.map fromByteString + >>= Streams.map byteString is1 <- Streams.fromList ["Bye, world!\n"] - >>= Streams.map fromByteString + >>= Streams.map byteString Streams.connect is0 os Streams.connect is1 os Streams.write Nothing os @@ -68,13 +70,13 @@ testUnsafeBuilderStream = testCase "builder/unsafeBuilderStream" $ do let l1 = intersperse " " ["the", "quick", "brown", "fox"] let l2 = intersperse " " ["jumped", "over", "the"] - let l = map fromByteString l1 ++ [flush] ++ map fromByteString l2 + let l = map byteString l1 ++ [flush] ++ map byteString l2 is <- fromList l (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0 - os <- unsafeBuilderStream (allocBuffer 1024) os1 + os <- unsafeBuilderStream (newBuffer 1024) os1 connect is os output <- grab @@ -89,11 +91,11 @@ testSmallBuffer :: Test testSmallBuffer = testCase "builder/smallBuffer" $ do (os0, grab) <- listOutputStream - os <- builderStreamWith (allNewBuffersStrategy 10) os0 + os <- builderStreamWithBufferSize 10 os0 let l1 = intersperse " " ["the", "quick", "brown"] let l2 = [" fooooooooooooooooox"] - let l = map fromByteString l1 ++ [flush, flush, flush] - ++ map fromByteString l2 + let l = map byteString l1 ++ [flush, flush, flush] + ++ map byteString l2 is <- fromList l connect is os @@ -108,20 +110,20 @@ testCase "builder/smallBufferWithLargeOutput" $ do (os0, grab) <- listOutputStream os1 <- contramapM (return . S.copy) os0 - os <- unsafeBuilderStream (allocBuffer 10) os1 + os <- unsafeBuilderStream (newBuffer 10) os1 let l = take 3000 $ cycle $ - replicate 20 (fromByteString "bloooooooort") ++ [flush] + replicate 20 (byteString "bloooooooort") ++ [flush] is <- fromList l - let s = toByteString $ mconcat l + let s = S.concat $ L.toChunks $ toLazyByteString $ mconcat l connect is os output <- liftM S.concat grab assertEqual "short buffer 2" s output - write (Just $ fromByteString "ok") os + write (Just $ byteString "ok") os write Nothing os fout <- grab diff --git a/test/System/IO/Streams/Tests/Concurrent.hs b/test/System/IO/Streams/Tests/Concurrent.hs --- a/test/System/IO/Streams/Tests/Concurrent.hs +++ b/test/System/IO/Streams/Tests/Concurrent.hs @@ -3,11 +3,7 @@ ------------------------------------------------------------------------------ import Control.Concurrent import Control.Monad -import Prelude hiding (lines, read, - takeWhile, unlines, - unwords, unwords, - words) -import qualified Prelude +import Prelude hiding (lines, read, takeWhile, unlines, unwords, unwords, words) import qualified System.IO.Streams as Streams import qualified System.IO.Streams.Concurrent as Streams import System.IO.Streams.Tests.Common diff --git a/test/System/IO/Streams/Tests/Handle.hs b/test/System/IO/Streams/Tests/Handle.hs --- a/test/System/IO/Streams/Tests/Handle.hs +++ b/test/System/IO/Streams/Tests/Handle.hs @@ -4,9 +4,9 @@ module System.IO.Streams.Tests.Handle (tests) where ------------------------------------------------------------------------------ -import Blaze.ByteString.Builder import Control.Exception import Control.Monad hiding (mapM) +import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Char8 as S import Data.List import Foreign.Marshal.Alloc (allocaBytes) @@ -76,8 +76,8 @@ os0 <- Streams.handleToOutputStream h os <- Streams.builderStream os0 - let l1 = map fromByteString ["the ", "quick ", "brown "] - let l2 = map fromByteString ["fox ", "jumped"] + let l1 = map byteString ["the ", "quick ", "brown "] + let l2 = map byteString ["fox ", "jumped"] Streams.fromList l1 >>= Streams.connectTo os Streams.fromList l2 >>= Streams.connectTo os S.readFile fn >>= assertEqual "eof should close" "the quick brown " diff --git a/test/System/IO/Streams/Tests/Zlib.hs b/test/System/IO/Streams/Tests/Zlib.hs --- a/test/System/IO/Streams/Tests/Zlib.hs +++ b/test/System/IO/Streams/Tests/Zlib.hs @@ -3,10 +3,11 @@ module System.IO.Streams.Tests.Zlib (tests) where ------------------------------------------------------------------------------ -import Blaze.ByteString.Builder import qualified Codec.Compression.GZip as GZ import qualified Codec.Compression.Zlib as Z import Control.Monad hiding (mapM) +import Data.ByteString.Builder (Builder, byteString) +import Data.ByteString.Builder.Extra (flush) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L @@ -18,7 +19,7 @@ import Test.QuickCheck hiding (output) import Test.QuickCheck.Monadic ------------------------------------------------------------------------------ -import System.IO.Streams hiding (fromByteString) +import System.IO.Streams import System.IO.Streams.Tests.Common tests :: [Test] @@ -153,10 +154,10 @@ propBuilderFlush name inf comp a b = do pre (not (S.null a) && not (S.null b)) liftQ $ do - t 7 [ fromByteString a, flush, flush, fromByteString b + t 7 [ byteString a, flush, flush, byteString b , flush, flush ] - t 4 [ fromByteString a, flush, flush, fromByteString b ] + t 4 [ byteString a, flush, flush, byteString b ] where t expected input = do