diff --git a/Data/Conduit/Blaze.hs b/Data/Conduit/Blaze.hs deleted file mode 100644 --- a/Data/Conduit/Blaze.hs +++ /dev/null @@ -1,158 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE BangPatterns #-} --- | Convert a stream of blaze-builder @Builder@s into a stream of @ByteString@s. --- --- Adapted from blaze-builder-enumerator, written by myself and Simon Meier. --- --- Note that the functions here can work in any monad built on top of @IO@ or --- @ST@. -module Data.Conduit.Blaze - ( - - -- * Buffers - Buffer - - -- ** Status information - , freeSize - , sliceSize - , bufferSize - - -- ** Creation and modification - , allocBuffer - , reuseBuffer - , nextSlice - - -- ** Conversion to bytestings - , unsafeFreezeBuffer - , unsafeFreezeNonEmptyBuffer - - -- * Buffer allocation strategies - , BufferAllocStrategy - , allNewBuffersStrategy - , reuseBufferStrategy - - -- * Conduits from builders to bytestrings - , builderToByteString - , unsafeBuilderToByteString - , builderToByteStringWith - - -- ** Flush - , builderToByteStringFlush - , builderToByteStringWithFlush - ) where - -import Data.Conduit hiding (Pipe (Done)) -import Control.Monad (liftM) - -import qualified Data.ByteString as S - -import Blaze.ByteString.Builder.Internal -import Blaze.ByteString.Builder.Internal.Types -import Blaze.ByteString.Builder.Internal.Buffer - --- | Incrementally execute builders and pass on the filled chunks as --- bytestrings. -builderToByteString :: MonadUnsafeIO m => Conduit Builder m S.ByteString -builderToByteString = - builderToByteStringWith (allNewBuffersStrategy defaultBufferSize) - --- | --- --- Since 0.0.2 -builderToByteStringFlush :: MonadUnsafeIO m => Conduit (Flush Builder) m (Flush S.ByteString) -builderToByteStringFlush = - builderToByteStringWithFlush (allNewBuffersStrategy defaultBufferSize) - --- | Incrementally execute builders on the given buffer and pass on the filled --- chunks as bytestrings. Note that, if the given buffer is too small for the --- execution of a build step, a larger one will be allocated. --- --- WARNING: This conduit yields bytestrings that are NOT --- referentially transparent. Their content will be overwritten as soon --- as control is returned from the inner sink! -unsafeBuilderToByteString :: MonadUnsafeIO m - => IO Buffer -- action yielding the inital buffer. - -> Conduit Builder m S.ByteString -unsafeBuilderToByteString = builderToByteStringWith . reuseBufferStrategy - - --- | A conduit that incrementally executes builders and passes on the --- filled chunks as bytestrings to an inner sink. --- --- INV: All bytestrings passed to the inner sink are non-empty. -builderToByteStringWith :: MonadUnsafeIO m - => BufferAllocStrategy - -> Conduit Builder m S.ByteString -builderToByteStringWith (ioBuf0, nextBuf) = conduitState - ioBuf0 - (push nextBuf) - close - where - close ioBuf = unsafeLiftIO $ do - buf <- ioBuf - return $ maybe [] return $ unsafeFreezeNonEmptyBuffer buf - --- | --- --- Since 0.0.2 -builderToByteStringWithFlush - :: MonadUnsafeIO m - => BufferAllocStrategy - -> Conduit (Flush Builder) m (Flush S.ByteString) -builderToByteStringWithFlush (ioBuf0, nextBuf) = conduitState - ioBuf0 - push' - close - where - close ioBuf = unsafeLiftIO $ do - buf <- ioBuf - return $ maybe [] (return . Chunk) $ unsafeFreezeNonEmptyBuffer buf - - push' :: MonadUnsafeIO m - => IO Buffer - -> Flush Builder - -> m (ConduitStateResult (IO Buffer) input (Flush S.ByteString)) - push' ioBuf Flush = do - StateProducing ioBuf' chunks <- push nextBuf ioBuf flush - let myFold bs rest - | S.null bs = rest - | otherwise = Chunk bs : rest - chunks' = foldr myFold [Flush] chunks - return $ StateProducing ioBuf' chunks' - push' ioBuf (Chunk builder) = (liftM . fmap) Chunk (push nextBuf ioBuf builder) - -push :: MonadUnsafeIO m - => (Int -> Buffer -> IO (IO Buffer)) - -> IO Buffer - -> Builder - -> m (ConduitStateResult (IO Buffer) input S.ByteString) -push nextBuf ioBuf0 x = unsafeLiftIO $ do - (ioBuf', front) <- go (unBuilder x (buildStep finalStep)) ioBuf0 id - return $ StateProducing ioBuf' $ front [] - where - finalStep !(BufRange pf _) = return $ Done pf () - - go bStep ioBuf front = do - !buf <- ioBuf - signal <- (execBuildStep bStep buf) - case signal of - Done op' _ -> return (return $ updateEndOfSlice buf op', front) - BufferFull minSize op' bStep' -> do - let buf' = updateEndOfSlice buf op' - {-# INLINE cont #-} - cont front' = do - -- sequencing the computation of the next buffer - -- construction here ensures that the reference to the - -- foreign pointer `fp` is lost as soon as possible. - ioBuf' <- nextBuf minSize buf' - go bStep' ioBuf' front' - case unsafeFreezeNonEmptyBuffer buf' of - Nothing -> cont front - Just bs -> cont (front . (bs:)) - InsertByteString op' bs bStep' -> do - let buf' = updateEndOfSlice buf op' - bsk = maybe id (:) $ unsafeFreezeNonEmptyBuffer buf' - bsk' = if S.null bs then id else (bs:) - front' = front . bsk . bsk' - ioBuf' <- nextBuf 1 buf' - go bStep' ioBuf' front' diff --git a/blaze-builder-conduit.cabal b/blaze-builder-conduit.cabal --- a/blaze-builder-conduit.cabal +++ b/blaze-builder-conduit.cabal @@ -1,6 +1,6 @@ Name: blaze-builder-conduit -Version: 0.4.0.2 -Synopsis: Convert streams of builders to streams of bytestrings. +Version: 1.1.0 +Synopsis: Convert streams of builders to streams of bytestrings. (deprecated) Description: Convert streams of builders to streams of bytestrings. License: BSD3 License-file: LICENSE @@ -10,34 +10,10 @@ Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit -extra-source-files: test/main.hs Library - Exposed-modules: Data.Conduit.Blaze Build-depends: base >= 4 && < 5 - , containers - , transformers >= 0.2.2 && < 0.4 - , bytestring >= 0.9 - , text >= 0.11 - , blaze-builder >= 0.2.1.4 && < 0.4 - , conduit >= 0.4 && < 0.5 - ghc-options: -Wall - -test-suite test - hs-source-dirs: test - main-is: main.hs - type: exitcode-stdio-1.0 - cpp-options: -DTEST - build-depends: conduit - , base - , hspec - , HUnit - , QuickCheck - , bytestring - , blaze-builder - , blaze-builder-conduit - , transformers - ghc-options: -Wall + , conduit >= 1.1 source-repository head type: git diff --git a/test/main.hs b/test/main.hs deleted file mode 100644 --- a/test/main.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -import Test.Hspec.Monadic -import Test.Hspec.HUnit () -import Test.Hspec.QuickCheck (prop) -import Test.HUnit - -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL -import Data.ByteString.Char8 () -import Data.Conduit.Blaze (builderToByteString, builderToByteStringFlush) -import Control.Monad.ST (runST) -import Data.Monoid -import qualified Data.ByteString as S -import Blaze.ByteString.Builder (fromByteString, toLazyByteString, insertLazyByteString, flush) -import qualified Data.ByteString.Lazy as L -import Data.ByteString.Lazy.Char8 () - -main :: IO () -main = hspecX $ do - describe "blaze" $ do - prop "idempotent to toLazyByteString" $ \bss' -> runST $ do - let bss = map S.pack bss' - let builders = map fromByteString bss - let lbs = toLazyByteString $ mconcat builders - let src = mconcat $ map (CL.sourceList . return) builders - outBss <- src C.$= builderToByteString C.$$ CL.consume - return $ lbs == L.fromChunks outBss - - it "works for large input" $ do - let builders = replicate 10000 (fromByteString "hello world!") - let lbs = toLazyByteString $ mconcat builders - let src = mconcat $ map (CL.sourceList . return) builders - outBss <- src C.$= builderToByteString C.$$ CL.consume - lbs @=? L.fromChunks outBss - - it "works for lazy bytestring insertion" $ do - let builders = replicate 10000 (insertLazyByteString "hello world!") - let lbs = toLazyByteString $ mconcat builders - let src = mconcat $ map (CL.sourceList . return) builders - outBss <- src C.$= builderToByteString C.$$ CL.consume - lbs @=? L.fromChunks outBss - - it "flush shouldn't bring in empty strings." $ do - let dat = ["hello", "world"] - src = CL.sourceList dat C.$= CL.map ((`mappend` flush) . fromByteString) - out <- src C.$= builderToByteString C.$$ CL.consume - dat @=? out - - prop "flushing" $ \bss' -> runST $ do - let bss = concatMap (\bs -> [C.Chunk $ S.pack bs, C.Flush]) $ filter (not . null) bss' - let src = CL.sourceList $ map (fmap fromByteString) bss - outBss <- src C.$= builderToByteStringFlush C.$$ CL.consume - if bss == outBss then return () else error (show (bss, outBss)) - return $ bss == outBss