Removed iothunk

Yesod/Core.hs

@@ -598,14 +598,13 @@ parseWaiRequest env session' key' = do
         langs''' = case lookup langKey gets' of
                      Nothing -> langs''
                      Just x -> x : langs''
-    rbthunk <- iothunk $ rbHelper env
     nonce <- case (key', lookup nonceKey session') of
                 (Nothing, _) -> return $ error "You have attempted to use the nonce, but sessions are disabled." -- FIXME maybe this should be handled without an error?
                 (_, Just x) -> return x
                 (_, Nothing) -> do
                     g <- newStdGen
                     return $ fst $ randomString 10 g
-    return $ Request gets' cookies' rbthunk env langs''' nonce
+    return $ Request gets' cookies' env langs''' nonce
   where
     randomString len =
         first (map toChar) . sequence' (replicate len (randomR (0, 61)))
@@ -622,37 +621,6 @@ parseWaiRequest env session' key' = do
 nonceKey :: String
 nonceKey = "_NONCE"
 
-rbHelper :: W.Request -> Iteratee ByteString IO RequestBodyContents
-rbHelper req =
-    (map fix1 *** map fix2) <$> iter
-  where
-    iter = NWP.parseRequestBody NWP.lbsSink req
-    fix1 = bsToChars *** bsToChars
-    fix2 (x, NWP.FileInfo a b c) =
-        (bsToChars x, FileInfo (bsToChars a) (bsToChars b) c)
-
--- | Produces a \"compute on demand\" value. The computation will be run once
--- it is requested, and then the result will be stored. This will happen only
--- once.
---
--- FIXME: remove this function and use a StateT in Handler
-iothunk :: Iteratee ByteString IO a -> IO (Iteratee ByteString IO a)
-iothunk =
-    fmap go . liftIO . newMVar . Left
-  where
-    go :: MVar (Either (Iteratee ByteString IO a) a) -> Iteratee ByteString IO a
-    go mvar = do
-        x <- liftIO $ takeMVar mvar
-        (x', a) <- go' x
-        liftIO $ putMVar mvar x'
-        return a
-    go' :: Either (Iteratee ByteString IO a) a
-        -> Iteratee ByteString IO (Either (Iteratee ByteString IO a) a, a)
-    go' (Right val) = return (Right val, val)
-    go' (Left comp) = do
-        val <- comp
-        return (Right val, val)
-
 -- FIXME don't duplicate
 sessionName :: ByteString
 sessionName = "_SESSION"

Yesod/Handler.hs

@@ -138,6 +138,8 @@ import Data.Maybe (fromMaybe)
 import Web.Cookie (SetCookie (..), renderSetCookie)
 import Blaze.ByteString.Builder (toByteString)
 import Data.Enumerator (run_, ($$))
+import Control.Arrow (first, (***))
+import qualified Network.Wai.Parse as NWP
 
 -- | The type-safe URLs associated with a site argument.
 type family Route a
@@ -233,7 +235,7 @@ type GHInner s m monad =
     ReaderT (HandlerData s m) (
     ErrorT HandlerContents (
     WriterT (Endo [Header]) (
-    StateT SessionMap ( -- session
+    StateT (SessionMap, Maybe RequestBodyContents) (
     monad
     ))))
 
@@ -273,8 +275,23 @@ instance Monad monad => Failure ErrorResponse (GGHandler sub master monad) where
 instance RequestReader (GHandler sub master) where
     getRequest = handlerRequest <$> GHandler ask
     runRequestBody = do
-        rr <- getRequest
+        (sm, mrbc) <- GHandler $ lift $ lift $ lift get
-        GHandler $ lift $ lift $ lift $ lift $ reqRequestBody rr
+        case mrbc of
+            Just rbc -> return rbc
+            Nothing -> do
+                rr <- waiRequest
+                rbc <- lift $ rbHelper rr
+                GHandler $ lift $ lift $ lift $ put (sm, Just rbc)
+                return rbc
+
+rbHelper :: W.Request -> Iteratee ByteString IO RequestBodyContents
+rbHelper req =
+    (map fix1 *** map fix2) <$> iter
+  where
+    iter = NWP.parseRequestBody NWP.lbsSink req
+    fix1 = bsToChars *** bsToChars
+    fix2 (x, NWP.FileInfo a b c) =
+        (bsToChars x, FileInfo (bsToChars a) (bsToChars b) c)
 
 -- | Get the sub application argument.
 getYesodSub :: Monad m => GGHandler sub master m sub
@@ -329,13 +346,14 @@ runHandler handler mrender sroute tomr ma tosa =
             , handlerRender = mrender
             , handlerToMaster = tomr
             }
-    ((contents', headers), finalSession) <- catchIter (
+    let initSession' = (initSession, Nothing)
-        flip runStateT initSession
+    ((contents', headers), (finalSession, _)) <- catchIter (
+        flip runStateT initSession'
       $ runWriterT
       $ runErrorT
       $ flip runReaderT hd
       $ unGHandler handler
-        ) (\e -> return ((Left $ HCError $ toErrorHandler e, id), initSession))
+        ) (\e -> return ((Left $ HCError $ toErrorHandler e, id), initSession'))
     let contents = either id (HCContent W.status200 . chooseRep) contents'
     let handleError e = do
             yar <- unYesodApp (eh e) safeEh rr cts finalSession
@@ -566,11 +584,11 @@ expiresAt = setHeader "Expires" . S8.pack . formatRFC1123
 setSession :: String -- ^ key
            -> String -- ^ value
            -> GHandler sub master ()
-setSession k = GHandler . lift . lift . lift . modify . Map.insert k
+setSession k = GHandler . lift . lift . lift . modify . first . Map.insert k
 
 -- | Unsets a session variable. See 'setSession'.
 deleteSession :: String -> GHandler sub master ()
-deleteSession = GHandler . lift . lift . lift . modify . Map.delete
+deleteSession = GHandler . lift . lift . lift . modify . first . Map.delete
 
 -- | Internal use only, not to be confused with 'setHeader'.
 addHeader :: Header -> GHandler sub master ()
@@ -601,12 +619,12 @@ localNoCurrent =
 -- | Lookup for session data.
 lookupSession :: ParamName -> GHandler s m (Maybe ParamValue)
 lookupSession n = GHandler $ do
-    m <- lift $ lift $ lift get
+    m <- fmap fst $ lift $ lift $ lift get
     return $ Map.lookup n m
 
 -- | Get all session variables.
 getSession :: GHandler s m SessionMap
-getSession = GHandler $ lift $ lift $ lift get
+getSession = fmap fst $ GHandler $ lift $ lift $ lift get
 
 #if TEST
 

Yesod/Request.hs

@@ -41,8 +41,6 @@ module Yesod.Request
     ) where
 
 import qualified Network.Wai as W
-import Data.ByteString (ByteString)
-import Data.Enumerator (Iteratee)
 import qualified Data.ByteString.Lazy as BL
 import "transformers" Control.Monad.IO.Class
 import Control.Monad (liftM)
@@ -99,18 +97,6 @@ data FileInfo = FileInfo
 data Request = Request
     { reqGetParams :: [(ParamName, ParamValue)]
     , reqCookies :: [(ParamName, ParamValue)]
-      -- | The POST parameters and submitted files. This is stored in an IO
-      -- thunk, which essentially means it will be computed once at most, but
-      -- only if requested. This allows avoidance of the potentially costly
-      -- parsing of POST bodies for pages which do not use them.
-      --
-      -- Additionally, since the request body is not read until needed, you can
-      -- directly access the 'W.requestBody' record in 'reqWaiRequest' and
-      -- perform other forms of parsing. For example, when designing a web
-      -- service, you may want to accept JSON-encoded data. Just be aware that
-      -- if you do such parsing, the standard POST form parsing functions will
-      -- no longer work.
-    , reqRequestBody :: Iteratee ByteString IO RequestBodyContents
     , reqWaiRequest :: W.Request
       -- | Languages which the client supports.
     , reqLangs :: [String]