-
--- | This is mostly the same as 'output' but is more efficient.
-outputBS :: ByteString -> Resource ()
-outputBS str = do outputChunkBS str
- driftTo Done
-{-# INLINE outputBS #-}
-
--- | Computation of @'outputChunk' str@ writes @str@ as a part of
--- response body. You can compute this action multiple times to write
--- a body little at a time. It is safe to apply 'outputChunk' to an
--- infinite string.
---
--- Note that 'outputChunkBS' is more efficient than 'outputChunk' so
--- you should use it whenever possible.
-outputChunk :: String -> Resource ()
-outputChunk str = outputChunkBS $! B.pack str
-{-# INLINE outputChunk #-}
-
--- | This is mostly the same as 'outputChunk' but is more efficient.
-outputChunkBS :: ByteString -> Resource ()
-outputChunkBS str
- = str `seq`
- do driftTo DecidingBody
- itr <- ask
-
- let limit = cnfMaxOutputChunkLength $ itrConfig itr
- when (limit <= 0)
- $ fail ("cnfMaxOutputChunkLength must be positive: "
- ++ show limit)
-
- discardBody <- liftIO $ atomically $
- readItr itr itrWillDiscardBody id
-
- unless (discardBody)
- $ sendChunks str limit
-
- unless (B.null str)
- $ liftIO $ atomically $
- writeItr itr itrBodyIsNull False
- where
- {- チャンクの大きさは Config で制限されてゐる。もし例へば
- /dev/zero を B.readFile して作った ByteString をそのまま
- ResponseWriter に渡したりすると大變な事が起こる。何故なら
- ResponseWriter はTransfer-Encoding: chunked の時、ヘッダを書く
- 爲にチャンクの大きさを測るから、その時に起こるであらう事は言ふ
- までも無い。 -}
- sendChunks :: ByteString -> Int -> Resource ()
- sendChunks str limit
- | B.null str = return ()
- | otherwise = do let (chunk, remaining) = B.splitAt (fromIntegral limit) str
- itr <- ask
- liftIO $ atomically $
- do buf <- readItr itr itrBodyToSend id
- if B.null buf then
- -- バッファが消化された
- writeItr itr itrBodyToSend chunk
- else
- -- 消化されるのを待つ
- retry
- -- 殘りのチャンクについて繰り返す
- sendChunks remaining limit
+output str = outputChunk str *> driftTo Done
+
+-- | Write a 'Lazy.ByteString' to the response body. This action can
+-- be repeated as many times as you want. It is safe to apply
+-- 'outputChunk' to an infinite string.
+outputChunk ∷ Lazy.ByteString → Resource ()
+outputChunk str
+ = do driftTo DecidingBody
+ itr ← getInteraction
+ liftIO $ atomically
+ $ do putTMVar (itrBodyToSend itr) (BB.fromLazyByteString str)
+ unless (Lazy.null str)
+ $ writeTVar (itrSentNoBodySoFar itr) False