@@ -15,6 +15,8 @@ module Network.Wai.Enumerator
1515 -- ** FilePath
1616 , fromFile
1717 , fromEitherFile
18+ -- * Filters
19+ , buffer
1820 ) where
1921
2022import Network.Wai (Enumerator (..), Source (..))
@@ -67,16 +69,16 @@ fromLBS' lbs' = Enumerator $ \iter a0 -> lbs' >>= \lbs ->
6769-- deadlocked.
6870toSource :: Enumerator -> IO Source
6971toSource (Enumerator e) = do
70− buffer <- newEmptyMVar
71− _ <- forkIO $ e (helper buffer) () >> putMVar buffer Nothing
72− return $ source buffer
72+ buff <- newEmptyMVar
73+ _ <- forkIO $ e (helper buff) () >> putMVar buff Nothing
74+ return $ source buff
7375 where
7476 helper :: MVar (Maybe B.ByteString)
7577 -> ()
7678 -> B.ByteString
7779 -> IO (Either () ())
78− helper buffer _ bs = do
79− putMVar buffer $ Just bs
80+ helper buff _ bs = do
81+ putMVar buff $ Just bs
8082 return $ Right ()
8183 source :: MVar (Maybe B.ByteString)
8284 -> Source
@@ -115,3 +117,24 @@ fromFile fp = Enumerator $ \iter a0 -> withBinaryFile fp ReadMode $ \h ->
115117-- be convenient for server implementations not optimizing file sending.
116118fromEitherFile :: Either FilePath Enumerator -> Enumerator
117119fromEitherFile = either fromFile id
120+
121+-- | Buffer chunks until we have a chunk of 'defaultChunkSize', and then send
122+-- it.
123+buffer :: Enumerator -> Enumerator
124+buffer (Enumerator e) =
125+ Enumerator go
126+ where
127+ go iter seed = do
128+ res <- e (iter' iter) (B.empty, seed)
129+ case res of
130+ Left (_, seed') -> return $ Left seed'
131+ Right (buff, seed') -> iter seed' buff
132+ iter' iter (buff, seed) bs = do
133+ if B.length buff + B.length bs < defaultChunkSize
134+ then return $ Right (buff `B.append` bs, seed)
135+ else do
136+ let (x, y) = B.splitAt (defaultChunkSize - B.length buff) bs
137+ res <- iter seed $ buff `B.append` x
138+ case res of
139+ Left seed' -> return $ Left (y, seed') -- y is ignored
140+ Right seed' -> return $ Right (y, seed')