1{-# LANGUAGE BangPatterns      #-}
2{-# LANGUAGE CPP               #-}
3{-# LANGUAGE OverloadedStrings #-}
4
5-- | Buffering for output streams based on bytestring builders.
6--
7-- Buffering an output stream can often improve throughput by reducing the
8-- number of system calls made through the file descriptor. The @bytestring@
9-- package provides an efficient monoidal datatype used for serializing values
10-- directly to an output buffer, called a 'Builder', originally implemented in
11-- the @blaze-builder@ package by Simon Meier. When compiling with @bytestring@
12-- versions older than 0.10.4, (i.e. GHC <= 7.6) users must depend on the
13-- @bytestring-builder@ library to get the new builder implementation. Since we
14-- try to maintain compatibility with the last three GHC versions, the
15-- dependency on @bytestring-builder@ can be dropped after the release of GHC
16-- 7.12.
17--
18--
19-- /Using this module/
20--
21-- Given an 'OutputStream' taking 'ByteString':
22--
23-- > someOutputStream :: OutputStream ByteString
24--
25-- You create a new output stream wrapping the original one that accepts
26-- 'Builder' values:
27--
28--
29-- @
30-- do
31--     newStream <- Streams.'builderStream' someOutputStream
32--     Streams.'write' ('Just' $ 'Data.ByteString.Builder.byteString' \"hello\") newStream
33--     ....
34-- @
35--
36--
37-- You can flush the output buffer using 'Data.ByteString.Builder.Extra.flush':
38--
39-- @
40--     ....
41--     Streams.'write' ('Just' 'Data.ByteString.Builder.Extra.flush') newStream
42--     ....
43-- @
44--
45-- As a convention, 'builderStream' will write the empty string to the wrapped
46-- 'OutputStream' upon a builder buffer flush. Output streams which receive
47-- 'ByteString' should either ignore the empty string or interpret it as a
48-- signal to flush their own buffers, as the @handleToOutputStream@ and
49-- "System.IO.Streams.Zlib" functions do.
50--
51-- /Example/
52--
53-- @
54-- example :: IO [ByteString]
55-- example = do
56--     let l1 = 'Data.List.intersperse' \" \" [\"the\", \"quick\", \"brown\", \"fox\"]
57--     let l2 = 'Data.List.intersperse' \" \" [\"jumped\", \"over\", \"the\"]
58--     let l  = map 'Data.ByteString.Builder.byteString' l1 ++ ['Data.ByteString.Builder.Extra.flush'] ++ map 'Data.ByteString.Builder.byteString' l2
59--     is          \<- Streams.'System.IO.Streams.fromList' l
60--     (os0, grab) \<- Streams.'System.IO.Streams.listOutputStream'
61--     os          \<- Streams.'builderStream' os0
62--     Streams.'System.IO.Streams.connect' is os >> grab
63--
64-- ghci> example
65-- [\"the quick brown fox\",\"\",\"jumped over the\"]
66-- @
67--
68module System.IO.Streams.Builder
69 ( -- * Blaze builder conversion
70   builderStream
71 , builderStreamWithBufferSize
72 , unsafeBuilderStream
73 ) where
74
75------------------------------------------------------------------------------
76import           Control.Monad                    (when)
77import           Data.ByteString.Builder.Internal (Buffer (..), BufferRange (..), Builder, byteStringFromBuffer, defaultChunkSize, fillWithBuildStep, newBuffer, runBuilder)
78import           Data.ByteString.Char8            (ByteString)
79import qualified Data.ByteString.Char8            as S
80import           Data.IORef                       (newIORef, readIORef, writeIORef)
81
82------------------------------------------------------------------------------
83import           System.IO.Streams.Internal       (OutputStream, makeOutputStream, write, writeTo)
84
85
86------------------------------------------------------------------------------
87builderStreamWithBufferFunc :: IO Buffer
88                            -> OutputStream ByteString
89                            -> IO (OutputStream Builder)
90builderStreamWithBufferFunc mkNewBuf os = do
91    ref <- newIORef Nothing
92    makeOutputStream $ chunk ref
93  where
94    chunk ref Nothing = do
95        mbuf <- readIORef ref
96        case mbuf of
97          -- If we existing buffer leftovers, write them to the output.
98          Nothing  -> return $! ()
99          Just buf -> writeBuf buf
100        write Nothing os
101    chunk ref (Just builder) = runStep ref $ runBuilder builder
102
103    getBuf ref = readIORef ref >>= maybe mkNewBuf return
104
105    bumpBuf (Buffer fp (BufferRange !_ endBuf)) endPtr =
106        Buffer fp (BufferRange endPtr endBuf)
107
108    updateBuf ref buf endPtr = writeIORef ref $! Just $! bumpBuf buf endPtr
109
110    writeBuf buf = do
111        let bs = byteStringFromBuffer buf
112        when (not . S.null $ bs) $ writeTo os $! Just bs
113
114    bufRange (Buffer _ rng) = rng
115
116    runStep ref step = do
117        buf <- getBuf ref
118        fillWithBuildStep step (cDone buf) (cFull buf) (cInsert buf)
119                          (bufRange buf)
120      where
121        cDone buf endPtr !() = updateBuf ref buf endPtr
122        cFull buf !endPtr !_ newStep = do
123            writeBuf $! bumpBuf buf endPtr
124            writeIORef ref Nothing
125            runStep ref newStep
126        cInsert buf !endPtr !bs newStep = do
127            writeBuf $! bumpBuf buf endPtr
128            writeIORef ref Nothing
129            writeTo os $! Just bs
130            runStep ref newStep
131
132
133------------------------------------------------------------------------------
134-- | Converts a 'ByteString' sink into a 'Builder' sink, using the supplied
135-- buffer size.
136--
137-- Note that if the generated builder receives a
138-- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string
139-- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output
140-- buffers are to be flushed.
141--
142-- /Since: 1.3.0.0./
143builderStreamWithBufferSize :: Int -> OutputStream ByteString -> IO (OutputStream Builder)
144builderStreamWithBufferSize bufsiz = builderStreamWithBufferFunc (newBuffer bufsiz)
145
146
147------------------------------------------------------------------------------
148-- | Converts a 'ByteString' sink into a 'Builder' sink.
149--
150-- Note that if the generated builder receives a
151-- 'Blaze.ByteString.Builder.flush', by convention it will send an empty string
152-- to the supplied @'OutputStream' 'ByteString'@ to indicate that any output
153-- buffers are to be flushed.
154--
155builderStream :: OutputStream ByteString -> IO (OutputStream Builder)
156builderStream = builderStreamWithBufferSize defaultChunkSize
157
158
159------------------------------------------------------------------------------
160-- | Unsafe variation on 'builderStream' that reuses an existing buffer for
161-- efficiency.
162--
163-- /NOTE/: because the buffer is reused, subsequent 'ByteString' values written
164-- to the wrapped 'OutputString' will cause previous yielded strings to change.
165-- Do not retain references to these 'ByteString' values inside the
166-- 'OutputStream' you pass to this function, or you will violate referential
167-- transparency.
168--
169-- If you /must/ retain copies of these values, then please use
170-- 'Data.ByteString.copy' to ensure that you have a fresh copy of the
171-- underlying string.
172--
173-- You can create a Buffer with 'Data.ByteString.Builder.Internal.newBuffer'.
174--
175unsafeBuilderStream :: IO Buffer
176                    -> OutputStream ByteString
177                    -> IO (OutputStream Builder)
178unsafeBuilderStream mkBuf os = do
179    buf <- mkBuf
180    builderStreamWithBufferFunc (return buf) os
181