From f812da5cfe314ab2a29f5e68aac1a7a7b39240d6 Mon Sep 17 00:00:00 2001
From: pho <pho@cielonegro.org>
Date: Sat, 31 Mar 2007 14:04:23 +0900
Subject: [PATCH] chunked output

darcs-hash:20070331050423-62b54-f774f4a48d9bf77adf6b88339561ecfa9ece2dbc.gz
---
 Network/HTTP/Lucu/ResponseWriter.hs | 16 +++++++++++++---
 examples/HelloWorld.hs              |  4 +++-
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index f47e1f0..266f825 100644
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -15,13 +15,17 @@ import           Network.HTTP.Lucu.Interaction
 import           Network.HTTP.Lucu.Response
 import           Prelude hiding (catch)
 import           System.IO
+import           Text.Printf
 
 import Debug.Trace
 
 
 responseWriter :: Handle -> InteractionQueue -> IO ()
 responseWriter h tQueue
-    = awaitSomethingToWrite
+    = catch awaitSomethingToWrite $ \ exc ->
+      case exc of
+        IOException _ -> return ()
+        _             -> print exc
     where
       awaitSomethingToWrite :: IO ()
       awaitSomethingToWrite 
@@ -104,14 +108,20 @@ responseWriter h tQueue
                                                   return chunk
                unless willDiscardBody
                           $ do if willChunkBody then
-                                   fail "FIXME: not implemented"
+                                   do hPrintf h "%x\r\n" (toInteger $ B.length chunk)
+                                      B.hPut  h chunk
+                                      hPutStr h "\r\n"
                                  else
                                    B.hPut h chunk
                                hFlush h
                awaitSomethingToWrite
 
       finishBodyChunk :: Interaction -> IO ()
-      finishBodyChunk itr = return () -- FIXME: not implemented
+      finishBodyChunk itr
+          = do willDiscardBody <- atomically $ readItr itr itrWillDiscardBody id
+               willChunkBody   <- atomically $ readItr itr itrWillChunkBody   id
+               when (not willDiscardBody && willChunkBody)
+                        $ hPutStr h "0\r\n" >> hFlush h
 
       finalize :: Interaction -> IO ()
       finalize itr
diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs
index d5b8d70..fe5b543 100644
--- a/examples/HelloWorld.hs
+++ b/examples/HelloWorld.hs
@@ -2,9 +2,11 @@ import Network
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Httpd
 import Network.HTTP.Lucu.Resource
+import System.Posix.Signals
 
 main :: IO ()
 main = let config    = defaultConfig { cnfServerPort = PortNumber 9999 }
            resources = mkResTree []
        in
-         runHttpd config resources
\ No newline at end of file
+         do installHandler sigPIPE Ignore Nothing
+            runHttpd config resources
\ No newline at end of file
-- 
2.40.0