blaze-builder-conduit-1.0.0/0000755000000000000000000000000012110322673014057 5ustar0000000000000000blaze-builder-conduit-1.0.0/LICENSE0000644000000000000000000000276712110322673015100 0ustar0000000000000000Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. blaze-builder-conduit-1.0.0/Setup.lhs0000644000000000000000000000016212110322673015666 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain blaze-builder-conduit-1.0.0/blaze-builder-conduit.cabal0000644000000000000000000000301212110322673021223 0ustar0000000000000000Name: blaze-builder-conduit Version: 1.0.0 Synopsis: Convert streams of builders to streams of bytestrings. Description: Convert streams of builders to streams of bytestrings. License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit 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 >= 1.0 && < 1.1 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 >= 1.3 , QuickCheck , bytestring , blaze-builder , blaze-builder-conduit , transformers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/conduit.git blaze-builder-conduit-1.0.0/test/0000755000000000000000000000000012110322673015036 5ustar0000000000000000blaze-builder-conduit-1.0.0/test/main.hs0000644000000000000000000000545712110322673016331 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} import Test.Hspec import Test.Hspec.QuickCheck (prop) 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 = hspec $ 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 `shouldBe` 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 `shouldBe` 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 `shouldBe` 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 it "large flush input" $ do let lbs = L.pack $ concat $ replicate 100000 [0..255] chunks = map (C.Chunk . fromByteString) (L.toChunks lbs) src = CL.sourceList chunks bss <- src C.$$ builderToByteStringFlush C.=$ CL.consume let unFlush (C.Chunk x) = [x] unFlush C.Flush = [] L.fromChunks (concatMap unFlush bss) `shouldBe` lbs blaze-builder-conduit-1.0.0/Data/0000755000000000000000000000000012110322673014730 5ustar0000000000000000blaze-builder-conduit-1.0.0/Data/Conduit/0000755000000000000000000000000012110322673016335 5ustar0000000000000000blaze-builder-conduit-1.0.0/Data/Conduit/Blaze.hs0000644000000000000000000001215612110322673017733 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} -- | 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 ( -- * Conduits from builders to bytestrings builderToByteString , unsafeBuilderToByteString , builderToByteStringWith -- ** Flush , builderToByteStringFlush , builderToByteStringWithFlush -- * Buffers , Buffer -- ** Status information , freeSize , sliceSize , bufferSize -- ** Creation and modification , allocBuffer , reuseBuffer , nextSlice -- ** Conversion to bytestings , unsafeFreezeBuffer , unsafeFreezeNonEmptyBuffer -- * Buffer allocation strategies , BufferAllocStrategy , allNewBuffersStrategy , reuseBufferStrategy ) where import Data.Conduit import Control.Monad (unless, liftM) import Control.Monad.Trans.Class (lift, MonadTrans) 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 = helper (liftM (fmap Chunk) await) yield' where yield' Flush = return () yield' (Chunk bs) = yield bs -- | -- -- Since 0.0.2 builderToByteStringWithFlush :: MonadUnsafeIO m => BufferAllocStrategy -> Conduit (Flush Builder) m (Flush S.ByteString) builderToByteStringWithFlush = helper await yield helper :: (MonadUnsafeIO m, Monad (t m), MonadTrans t) => t m (Maybe (Flush Builder)) -> (Flush S.ByteString -> t m ()) -> BufferAllocStrategy -> t m () helper await' yield' (ioBufInit, nextBuf) = loop ioBufInit where loop ioBuf = do await' >>= maybe (close ioBuf) (cont' ioBuf) cont' ioBuf Flush = push ioBuf flush $ \ioBuf' -> yield' Flush >> loop ioBuf' cont' ioBuf (Chunk builder) = push ioBuf builder loop close ioBuf = do buf <- lift $ unsafeLiftIO $ ioBuf maybe (return ()) (yield' . Chunk) (unsafeFreezeNonEmptyBuffer buf) push ioBuf0 x continue = do go (unBuilder x (buildStep finalStep)) ioBuf0 where finalStep !(BufRange pf _) = return $ Done pf () go bStep ioBuf = do !buf <- lift $ unsafeLiftIO $ ioBuf signal <- lift $ unsafeLiftIO $ execBuildStep bStep buf case signal of Done op' _ -> continue $ return $ updateEndOfSlice buf op' BufferFull minSize op' bStep' -> do let buf' = updateEndOfSlice buf op' {-# INLINE cont #-} cont = 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' <- lift $ unsafeLiftIO $ nextBuf minSize buf' go bStep' ioBuf' case unsafeFreezeNonEmptyBuffer buf' of Nothing -> return () Just bs -> yield' (Chunk bs) cont InsertByteString op' bs bStep' -> do let buf' = updateEndOfSlice buf op' case unsafeFreezeNonEmptyBuffer buf' of Nothing -> return () Just bs' -> yield' $ Chunk bs' unless (S.null bs) $ yield' $ Chunk bs lift (unsafeLiftIO $ nextBuf 1 buf') >>= go bStep'