wai 0.3

Yesod/Content.hs

@@ -8,7 +8,7 @@
 
 module Yesod.Content
     ( -- * Content
-      Content
+      Content (..)
     , emptyContent
     , ToContent (..)
       -- * Mime types
@@ -57,8 +57,6 @@ import qualified Data.ByteString.Lazy as L
 import Data.Text.Lazy (Text)
 import qualified Data.Text as T
 
-import qualified Network.Wai as W
-
 import Data.Time
 import System.Locale
 
@@ -72,11 +70,16 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.HUnit hiding (Test)
 #endif
 
-type Content = W.ResponseBody
+import Data.Enumerator (Enumerator)
+import Blaze.ByteString.Builder (Builder)
+
+data Content = ContentLBS L.ByteString
+             | ContentEnum (forall a. Enumerator Builder IO a)
+             | ContentFile FilePath
 
 -- | Zero-length enumerator.
 emptyContent :: Content
-emptyContent = W.ResponseLBS L.empty
+emptyContent = ContentLBS L.empty
 
 -- | Anything which can be converted into 'Content'. Most of the time, you will
 -- want to use the 'ContentEnum' constructor. An easier approach will be to use
@@ -86,13 +89,13 @@ class ToContent a where
     toContent :: a -> Content
 
 instance ToContent B.ByteString where
-    toContent = W.ResponseLBS . L.fromChunks . return
+    toContent = ContentLBS . L.fromChunks . return
 instance ToContent L.ByteString where
-    toContent = W.ResponseLBS
+    toContent = ContentLBS
 instance ToContent T.Text where
     toContent = toContent . Data.Text.Encoding.encodeUtf8
 instance ToContent Text where
-    toContent = W.ResponseLBS . Data.Text.Lazy.Encoding.encodeUtf8
+    toContent = ContentLBS . Data.Text.Lazy.Encoding.encodeUtf8
 instance ToContent String where
     toContent = toContent . T.pack
 

Yesod/Dispatch.hs

@@ -43,7 +43,7 @@ import Web.Routes.Quasi.TH
 import Language.Haskell.TH.Syntax
 
 import qualified Network.Wai as W
-import Network.Wai.Middleware.CleanPath (cleanPathFunc)
+import Network.Wai.Middleware.CleanPath (cleanPath)
 import Network.Wai.Middleware.Jsonp
 import Network.Wai.Middleware.Gzip
 
@@ -75,6 +75,9 @@ import System.Random (randomR, newStdGen)
 
 import qualified Data.Map as Map
 
+import Control.Applicative ((<$>))
+import Data.Enumerator (($$), run_)
+
 #if TEST
 import Test.Framework (testGroup, Test)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -234,15 +237,25 @@ sessionName :: String
 sessionName = "_SESSION"
 
 -- | Convert the given argument into a WAI application, executable with any WAI
--- handler. You can use 'basicHandler' if you wish.
+-- handler. This is the same as 'toWaiAppPlain', except it includes three
-toWaiApp :: (Yesod y, YesodSite y) => y -> IO W.Application
+-- middlewares: GZIP compression, JSON-P and path cleaning. This is the
-toWaiApp a = do
+-- recommended approach for most users.
+toWaiApp :: (Yesod y, YesodSite y) => y -> IO (W.Application a)
+toWaiApp y = do
+    a <- toWaiAppPlain y
+    return $ gzip False
+           $ jsonp
+             a
+
+-- | Convert the given argument into a WAI application, executable with any WAI
+-- handler. This differs from 'toWaiApp' in that it only uses the cleanpath
+-- middleware.
+toWaiAppPlain :: (Yesod y, YesodSite y) => y -> IO (W.Application a)
+toWaiAppPlain a = do
     key' <- if enableClientSessions a
                 then Just `fmap` encryptKey a
                 else return Nothing
-    return $ gzip
+    return $ cleanPath (splitPath a) (B.pack $ approot a)
-           $ jsonp
-           $ cleanPathFunc (splitPath a) (B.pack $ approot a)
            $ toWaiApp' a key'
 
 toWaiApp' :: (Yesod y, YesodSite y)
@@ -250,7 +263,7 @@ toWaiApp' :: (Yesod y, YesodSite y)
           -> Maybe Key
           -> [String]
           -> W.Request
-          -> IO W.Response
+          -> IO (W.Response a)
 toWaiApp' y key' segments env = do
     now <- getCurrentTime
     let getExpires m = fromIntegral (m * 60) `addUTCTime` now
@@ -318,7 +331,12 @@ toWaiApp' y key' segments env = do
                           : hs
         hs'' = map (headerToPair getExpires) hs'
         hs''' = ("Content-Type", charsToBs ct) : hs''
-    return $ W.Response s hs''' c
+    return $
+        case c of
+            ContentLBS lbs -> W.ResponseLBS s hs''' lbs
+            ContentFile fp -> W.ResponseFile s hs''' fp
+            ContentEnum e -> W.ResponseEnumerator $ \iter ->
+                run_ $ e $$ iter s hs'''
 
 httpAccept :: W.Request -> [ContentType]
 httpAccept = map B.unpack
@@ -399,8 +417,12 @@ nonceKey :: String
 nonceKey = "_NONCE"
 
 rbHelper :: W.Request -> IO RequestBodyContents
-rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
+rbHelper req =
-    fix1 = map (bsToChars *** bsToChars)
+    (map fix1 *** map fix2) <$> run_ (enum $$ iter)
+  where
+    enum = W.requestBody req
+    iter = parseRequestBody lbsSink req
+    fix1 = bsToChars *** bsToChars
     fix2 (x, NWP.FileInfo a b c) =
         (bsToChars x, FileInfo (bsToChars a) (bsToChars b) c)
 

Yesod/Handler.hs

@@ -311,7 +311,7 @@ runHandler handler mrender sroute tomr ma tosa =
             let hs' = headers hs
             return (getStatus e, hs', ct, c, sess)
     let sendFile' ct fp =
-            return (W.status200, headers [], ct, W.ResponseFile fp, finalSession)
+            return (W.status200, headers [], ct, ContentFile fp, finalSession)
     case contents of
         HCContent status a -> do
             (ct, c) <- chooseRep a cts
@@ -559,3 +559,6 @@ testSuite = testGroup "Yesod.Handler"
     ]
 
 #endif
+
+-- FIXME add a sendEnum that uses a ResponseEnumerator and bypasses all status
+-- and header stuff

Yesod/Json.hs

@@ -1,4 +1,5 @@
 -- | Efficient generation of JSON documents.
+-- FIXME remove this module, possibly make a blaze-json
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}

yesod.cabal

@@ -29,8 +29,8 @@ library
     else
         build-depends:   base                      >= 4        && < 4.3
     build-depends:   time                      >= 1.1.4    && < 1.3
-                   , wai                       >= 0.2.0    && < 0.3
+                   , wai                       >= 0.3      && < 0.4
-                   , wai-extra                 >= 0.2.4    && < 0.3
+                   , wai-extra                 >= 0.3      && < 0.4
                    , bytestring                >= 0.9.1.4  && < 0.10
                    , directory                 >= 1        && < 1.2
                    , text                      >= 0.5      && < 0.12
@@ -55,6 +55,7 @@ library
                    , failure                   >= 0.1      && < 0.2
                    , containers                >= 0.2      && < 0.5
                    , monad-peel                >= 0.1      && < 0.2
+                   , enumerator                >= 0.4      && < 0.5
     exposed-modules: Yesod
                      Yesod.Content
                      Yesod.Dispatch