summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWilliamCasarin <>2015-11-30 05:51:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-11-30 05:51:00 (GMT)
commit8e8e35c53abe96d8941c8d91adc66fd605beebab (patch)
tree9e7b94494c77e624068fb54882a6016295fe9271
parent719df1ce1cbd98df93c2bd8afd48414e742150aa (diff)
version 0.1.1HEAD0.1.1master
-rw-r--r--src/Network/Wai/Streaming.hs30
-rw-r--r--streaming-wai.cabal2
2 files changed, 23 insertions, 9 deletions
diff --git a/src/Network/Wai/Streaming.hs b/src/Network/Wai/Streaming.hs
index bdcad56..405ede1 100644
--- a/src/Network/Wai/Streaming.hs
+++ b/src/Network/Wai/Streaming.hs
@@ -2,6 +2,7 @@
module Network.Wai.Streaming ( Flush(..)
-- * ByteStrings
+ , streamingRequest
, streamingResponse
, streamingBody
@@ -13,16 +14,29 @@ module Network.Wai.Streaming ( Flush(..)
import Streaming
import Network.Wai
+import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (byteString, Builder)
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status
import Streaming.Prelude as S
+import Data.ByteString as BS
-data Flush a = Chunk !a
+data Flush a = Chunk a
| Flush
deriving (Show, Functor)
+-- | Stream the 'Request' body
+streamingRequest :: MonadIO m => Request -> Stream (Of ByteString) m ()
+streamingRequest req = loop
+ where
+ go = liftIO (requestBody req)
+ loop = do
+ bs <- go
+ unless (BS.null bs) $ do
+ yield bs
+ loop
+
-- | Stream strict 'ByteString's into a 'Response'
streamingResponse :: Stream (Of ByteString) IO r
@@ -35,11 +49,11 @@ streamingResponse src status headers =
-- | Stream strict 'ByteString's into a 'StreamingBody'
streamingBody :: Stream (Of ByteString) IO r -> StreamingBody
-streamingBody src write flush = S.foldM_ writer flush return src
+streamingBody src write flush = void $ effects $ for src writer
where
- writer _ a = do
- write (byteString a)
- flush
+ writer a = do
+ lift (write (byteString a))
+ lift flush
-- $flush
--
@@ -56,7 +70,7 @@ streamingResponseF src status headers =
-- | Stream 'Builder's into a 'StreamingBody'
streamingBodyF :: Stream (Of (Flush Builder)) IO r -> StreamingBody
-streamingBodyF src write flush = S.foldM_ writer flush return src
+streamingBodyF src write flush = void $ effects $ for src writer
where
- writer _ (Chunk a) = write a
- writer _ Flush = flush
+ writer (Chunk a) = lift (write a)
+ writer Flush = lift flush
diff --git a/streaming-wai.cabal b/streaming-wai.cabal
index 6b123ce..4b666f4 100644
--- a/streaming-wai.cabal
+++ b/streaming-wai.cabal
@@ -1,5 +1,5 @@
name: streaming-wai
-version: 0.1.0
+version: 0.1.1
synopsis: Streaming Wai utilities
description: Please see README.md
homepage: http://github.com/jb55/streaming-wai