blaze-builder-conduit 0.4.0.2 → 0.5.0

raw patch · 3 files changed

+73/−80 lines, 3 filesdep ~basedep ~conduitPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, conduit

API changes (from Hackage documentation)

Files

• Data/Conduit/Blaze.hs +62/−77
• blaze-builder-conduit.cabal +2/−2
• test/main.hs +9/−1

@@ -9,8 +9,17 @@ module Data.Conduit.Blaze     ( +  -- * Conduits from builders to bytestrings+    builderToByteString+  , unsafeBuilderToByteString+  , builderToByteStringWith++  -- ** Flush+  , builderToByteStringFlush+  , builderToByteStringWithFlush+   -- * Buffers-    Buffer+  , Buffer    -- ** Status information   , freeSize@@ -30,19 +39,11 @@   , 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 Data.Conduit hiding (Source, Conduit, Sink, Pipe)+import Control.Monad (unless)+import Control.Monad.Trans.Class (lift)  import qualified Data.ByteString                   as S @@ -52,14 +53,14 @@  -- | Incrementally execute builders and pass on the filled chunks as -- bytestrings.-builderToByteString :: MonadUnsafeIO m => Conduit Builder m S.ByteString+builderToByteString :: MonadUnsafeIO m => GInfConduit Builder m S.ByteString builderToByteString =   builderToByteStringWith (allNewBuffersStrategy defaultBufferSize)  -- | -- -- Since 0.0.2-builderToByteStringFlush :: MonadUnsafeIO m => Conduit (Flush Builder) m (Flush S.ByteString)+builderToByteStringFlush :: MonadUnsafeIO m => GInfConduit (Flush Builder) m (Flush S.ByteString) builderToByteStringFlush =   builderToByteStringWithFlush (allNewBuffersStrategy defaultBufferSize) @@ -72,7 +73,7 @@ -- as control is returned from the inner sink! unsafeBuilderToByteString :: MonadUnsafeIO m                           => IO Buffer  -- action yielding the inital buffer.-                          -> Conduit Builder m S.ByteString+                          -> GInfConduit Builder m S.ByteString unsafeBuilderToByteString = builderToByteStringWith . reuseBufferStrategy  @@ -82,15 +83,12 @@ -- 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+                        -> GInfConduit Builder m S.ByteString+builderToByteStringWith =+    mapOutputMaybe unChunk . mapInput Chunk unChunk . builderToByteStringWithFlush   where-    close ioBuf = unsafeLiftIO $ do-        buf <- ioBuf-        return $ maybe [] return $ unsafeFreezeNonEmptyBuffer buf+    unChunk Flush = Nothing+    unChunk (Chunk y) = Just y  -- | --@@ -98,61 +96,48 @@ builderToByteStringWithFlush     :: MonadUnsafeIO m     => BufferAllocStrategy-    -> Conduit (Flush Builder) m (Flush S.ByteString)-builderToByteStringWithFlush (ioBuf0, nextBuf) = conduitState-    ioBuf0-    push'-    close+    -> GInfConduit (Flush Builder) m (Flush S.ByteString)+builderToByteStringWithFlush (ioBufInit, nextBuf) =+    loop ioBufInit   where-    close ioBuf = unsafeLiftIO $ do-        buf <- ioBuf-        return $ maybe [] (return . Chunk) $ unsafeFreezeNonEmptyBuffer buf+    loop ioBuf = do+        awaitE >>= either (close ioBuf) (cont' ioBuf) -    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)+    cont' ioBuf Flush = push ioBuf flush $ \ioBuf' -> yield Flush >> loop ioBuf'+    cont' ioBuf (Chunk builder) = push ioBuf builder loop -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 ()+    close ioBuf r = do+        buf <- lift $ unsafeLiftIO $ ioBuf+        maybe (return ()) (yield . Chunk) (unsafeFreezeNonEmptyBuffer buf)+        return r -    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'+    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'

@@ -1,5 +1,5 @@ Name:                blaze-builder-conduit-Version:             0.4.0.2+Version:             0.5.0 Synopsis:            Convert streams of builders to streams of bytestrings. Description:         Convert streams of builders to streams of bytestrings. License:             BSD3@@ -20,7 +20,7 @@                      , bytestring               >= 0.9                      , text                     >= 0.11                      , blaze-builder            >= 0.2.1.4      && < 0.4-                     , conduit                  >= 0.4          && < 0.5+                     , conduit                  >= 0.5          && < 0.6   ghc-options:     -Wall  test-suite test

@@ -17,7 +17,7 @@ import Data.ByteString.Lazy.Char8 ()  main :: IO ()-main = hspecX $ do+main = hspec $ do     describe "blaze" $ do         prop "idempotent to toLazyByteString" $ \bss' -> runST $ do             let bss = map S.pack bss'@@ -53,3 +53,11 @@             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) @?= lbs