[Haskell-cafe] Using Wai with Conduit and ResourceT (was Re: (New to Conduits) mixing lazy lists and Conduits?)

Michael Snoyman michael at snoyman.com
Fri Jun 29 12:47:17 UTC 2018


I'm not set up to run a FastCGI script easily on my system, but replacing
your example with Warp as the handler works just fine on my machine.

On Fri, Jun 29, 2018 at 12:41 PM Jon Fairbairn <jon.fairbairn at cl.cam.ac.uk>
wrote:

> Michael Snoyman <michael at snoyman.com> writes:
>
> > I'd have to see a complete repro to know why the program in question
> > doesn't stream.
>
> Thanks. Here’s a fairly small example
>
> ```
> module Main where
>
> import Prelude hiding (mapM_)
> import Conduit
> import Data.Conduit.List (mapM_)
> import System.FilePath
> import Data.ByteString.UTF8
> import Data.Binary.Builder
> import GHC.IO.Exception (IOException)
>
> import Network.Wai.Handler.FastCGI (run)
> import Network.Wai.Conduit (Application, responseStream)
> import Network.HTTP.Types.Status
> import Network.HTTP.Types.Header
>
> data_directory = "./test-data/"
>
> main = run $ app
>
> app:: Application
> app request respond
>   = do respond
>          $ responseSourceRes status200
>            [(hContentType, fromString "text/plain; charset=UTF-8")]
>          $ do yieldCBS "\nBEGIN\n"
>               yield Flush
>               wrapSourceFile $ data_directory </> "file1"
>               wrapSourceFile $ data_directory </> "a_pipe"
>               yieldCBS "END\n"
>               yield Flush
>
> wrapSourceFile:: (MonadUnliftIO m, MonadResource m) => FilePath ->
> ConduitM a (Flush Builder) m ()
> wrapSourceFile path = do
>   yieldCBS ("\n" ++ path ++ ":\n")
>   catchC (sourceFile path .| mapC (Chunk . fromByteString)) (\e ->
> yieldCBS $ "Error: " ++ show (e::IOException) ++ "\n")
>   yieldCBS "\n"
>   yield Flush
>
> yieldCBS:: Monad m => String -> ConduitT i (Flush Builder) m ()
> yieldCBS = yield . Chunk . fromByteString . fromString
>
> responseSourceRes status headers res_conduit
>   = responseStream status200 headers
>     (\send flush -> runConduitRes $ res_conduit
>                     .| mapM_ (\e->liftIO $
>                                   case e of
>                                     Chunk c -> send c
>                                     Flush -> flush ))
>
> ```
>
> The various flushes in there were attempts to make something
> come out.
>
> > But I _can_ explain how best to do something like this.
>
> > To frame this: why is something like ResourceT needed here? The issue is
> we
> > want to ensure exception safety around the open file handle, and
> guarantee
> > that the handle is closed regardless of any exceptions being thrown.
> > ResourceT solves this problem by letting you register cleanup actions.
> This
> > allows for solving some really complicated dynamic allocation problems,
> but
> > for most cases it's overkill. Instead, a simple use of the bracket
> pattern
> > is sufficient. You can do that with `withSourceFile`:
> >
> > ```
> > #!/usr/bin/env stack
> > -- stack --resolver lts-11.10 script
> > import Network.Wai
> > import Network.Wai.Handler.Warp
> > import Network.Wai.Conduit
> > import Network.HTTP.Types
> > import Conduit
> > import Data.ByteString.Builder (byteString)
> >
> > main :: IO ()
> > main = run 3000 app
> >
> > app :: Application
> > app _req respond =
> >   withSourceFile "Main.hs" $ \src ->
> >   respond $ responseSource status200 []
> >           $ src .| mapC (Chunk . byteString)
>
> I don’t think that will work for what I’m trying to do as the
> decision to open which file is made within the conduit.
>
> > You can also do this by sticking with ResourceT, which requires jumping
> > through some hoops with monad transformers to ensure the original
> ResourceT
> > context is used. I don't recommend this approach unless you really need
> it:
> > it's complicated, and slightly slower than the above. But in case you're
> > curious:
>
> Thanks.  I think that may be what I want, but it’ll take a while
> to digest
>
> --
> Jón Fairbairn                                 Jon.Fairbairn at cl.cam.ac.uk
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20180629/a00baaad/attachment.html>


More information about the Haskell-Cafe mailing list