I've made a few more changes to WAI since my last update. Namely, request
and response headers are now their own datatype. As with Method, HttpVersion
and Status, they both provide constructors for "everything else" and have
functions to convert to/from bytestrings. This makes the package a bit more
consistent, as well as giving us some more type safety and perhaps even some
(negligible) performance gains. (Thanks again to Mark for the idea.)

Another feature that will be added is a wrapper module. This will provide
convenience functions for accessing the request body and generating a
response body via other methods. For example, it will provide a lazy I/O
interface for the request body and generating a response from a lazy
bytestring. (Thanks to Nicolas for the idea.)

The reason that it has not been written yet is because I have two options
available for the request and response body interfaces. One is a direct copy
of Hyena's enumerators, sans impredicative types. The other is a simpler I/O
interface. Here are the benefits of each as I see it:

Hyena enumerators:
Provide accumulating parameter support.
Provide mechanism for early response termination.
Probably makes the server side of the request body simpler to program.

Simple interface:
More obvious how to use it.
Makes the application side of the request body simpler to program.

You can see the code for each in github:
Enumerator: http://github.com/snoyberg/wai/blob/enumerator/Network/Wai.hs
Simple: http://github.com/snoyberg/wai/blob/master/Network/Wai.hs

I'm currently leaning to the enumerator approach, since it should be simple
application side to wrap the enumerator into a more tractable interface.
However, I'd like to hear people's opinions on this. To get an idea of how
this changes code, I'm attaching a diff of the two branches, which includes
a simple HTTP server and application.

I'm also aware that documentation is sorely lacking right now; once we come
to a decision on this piece of the interface, I'll add the wrapper functions
and comment appropriately. Commenting at this stage would be putting the
cart before the horse.

Michael
diff --git a/Network/Wai.hs b/Network/Wai.hs
index 9807c44..4466b2c 100644
--- a/Network/Wai.hs
+++ b/Network/Wai.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Rank2Types #-}
 module Network.Wai
     ( -- * Data types
       -- ** Request method
@@ -23,6 +23,8 @@ module Network.Wai
     , Status (..)
     , statusCode
     , statusMessage
+      -- * Enumerator
+    , Enumerator
       -- * WAI interface
     , Request (..)
     , Response (..)
@@ -233,6 +235,8 @@ statusMessage Status405 = B8.pack "Method Not Allowed"
 statusMessage Status500 = B8.pack "Internal Server Error"
 statusMessage (Status _ m) = m
 
+type Enumerator a = (a -> B.ByteString -> IO (Either a a)) -> a -> IO a
+
 data Request = Request
   {  requestMethod  :: Method
   ,  httpVersion    :: HttpVersion
@@ -242,7 +246,7 @@ data Request = Request
   ,  serverPort     :: Int
   ,  httpHeaders    :: [(RequestHeader, B.ByteString)]
   ,  urlScheme      :: UrlScheme
-  ,  requestBody    :: IO (Maybe B.ByteString)
+  ,  requestBody    :: forall a. Enumerator a
   ,  errorHandler   :: String -> IO ()
   ,  remoteHost     :: String
   }
@@ -250,7 +254,7 @@ data Request = Request
 data Response = Response
   { status        :: Status
   , headers       :: [(ResponseHeader, B.ByteString)]
-  , body          :: Either FilePath ((B.ByteString -> IO ()) -> IO ())
+  , body          :: forall a. Either FilePath (Enumerator a)
   }
 
 type Application = Request -> IO Response
diff --git a/Network/Wai/Handler/SimpleServer.hs 
b/Network/Wai/Handler/SimpleServer.hs
index 72f7280..6e4d3ba 100644
--- a/Network/Wai/Handler/SimpleServer.hs
+++ b/Network/Wai/Handler/SimpleServer.hs
@@ -21,7 +21,6 @@ import Network.Wai
 import qualified System.IO
 
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as B8
 import Network
     ( listenOn, accept, sClose, PortID(PortNumber), Socket
@@ -135,14 +134,16 @@ parseRequest port lines' handle remoteHost' = do
                 , remoteHost = remoteHost'
                 }
 
-requestBodyHandle :: Handle -> MVar Int -> IO (Maybe BS.ByteString)
-requestBodyHandle h mlen = modifyMVar mlen helper where
-    helper :: Int -> IO (Int, Maybe BS.ByteString)
-    helper 0 = return (0, Nothing)
-    helper len = do
+requestBodyHandle :: Handle -> MVar Int -> Enumerator a
+requestBodyHandle h mlen iter accum = modifyMVar mlen (helper accum) where
+    helper a 0 = return (0, a)
+    helper a len = do
         bs <- BS.hGet h len
         let newLen = len - BS.length bs
-        return (newLen, Just bs)
+        ea' <- iter a bs
+        case ea' of
+            Left a' -> return (newLen, a')
+            Right a' -> helper a' newLen
 
 parseFirst :: (StringLike s, MonadFailure InvalidRequest m) =>
               s
@@ -167,8 +168,9 @@ sendResponse h res = do
     BS.hPut h $ SL.pack "\r\n"
     case body res of
         Left fp -> unsafeSendFile h fp
-        Right enum -> enum $ BS.hPut h
+        Right enum -> enum myPut h >> return ()
     where
+        myPut _ bs = BS.hPut h bs >> return (Right h)
         putHeader (x, y) = do
             BS.hPut h $ responseHeaderToBS x
             BS.hPut h $ SL.pack ": "
diff --git a/test.hs b/test.hs
index 1e8b5c1..a92d1e5 100644
--- a/test.hs
+++ b/test.hs
@@ -1,7 +1,7 @@
+{-# LANGUAGE Rank2Types #-}
 import Network.Wai
 import Network.Wai.Handler.SimpleServer
 import qualified Data.ByteString.Char8 as B8
-import qualified Data.ByteString as B
 
 main :: IO ()
 main = putStrLn "http://localhost:3000/"; >> run 3000 app
@@ -18,19 +18,12 @@ indexResponse = return Response
     , body = index
     }
 
-postResponse :: IO (Maybe B.ByteString) -> IO Response
+postResponse :: (forall a. Enumerator a) -> IO Response
 postResponse rb = return Response
     { status = Status200
     , headers = [(ContentType, B8.pack "text/plain")]
-    , body = Right $ postBody rb
+    , body = Right rb
     }
 
 index :: Either FilePath a
 index = Left "index.html"
-
-postBody :: IO (Maybe B.ByteString) -> (B.ByteString -> IO ()) -> IO ()
-postBody req res = do
-    mbs <- req
-    case mbs of
-        Nothing -> return ()
-        Just bs -> res bs >> postBody req res
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to