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