From 60046bad966be10777d6cd9fdf4e6de4ea4bb2ef Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 20 Aug 2012 13:07:58 -0300 Subject: [PATCH 1/3] yesod-core: New handlerToIO function. --- yesod-core/Yesod/Handler.hs | 64 +++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index 6e70f20c..e6775471 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -95,6 +95,7 @@ module Yesod.Handler , newIdent -- * Lifting , MonadLift (..) + , handlerToIO -- * i18n , getMessageRender -- * Per-request caching @@ -177,6 +178,7 @@ import Control.Exception.Lifted (catch) import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Control.Monad.Base +import Data.Conduit.List (sourceList) import Yesod.Routes.Class import Data.Word (Word64) import Language.Haskell.TH.Syntax (Loc) @@ -391,6 +393,68 @@ getCurrentRoute = handlerRoute `liftM` ask getRouteToMaster :: GHandler sub master (Route sub -> Route master) getRouteToMaster = handlerToMaster `liftM` ask + +-- | Returns a function that runs 'GHandler' actions inside @IO@. +-- +-- Sometimes you want to run an inner 'GHandler' action outside +-- the control flow of an HTTP request (on the outer 'GHandler' +-- action). For example, you may want to spawn a new thread: +-- +-- @ +-- getFooR :: Handler RepHtml +-- getFooR = do +-- runHandler <- handlerToIO +-- liftIO $ forkIO $ runHandler $ do +-- /Code here runs inside GHandler but on a new thread./ +-- /This is the inner GHandler./ +-- ... +-- /Code here runs inside the request's control flow./ +-- /This is the outer GHandler./ +-- ... +-- @ +-- +-- Another use case for this function is creating a stream of +-- server-sent events using 'GHandler' actions (see +-- @yesod-eventsource@). +-- +-- Most of the environment from the outer 'GHandler' is preserved +-- on the inner 'GHandler', however: +-- +-- * The request body is cleared (otherwise it would be very +-- difficult to prevent huge memory leaks). +-- +-- * The cache is cleared (see 'CacheKey'). +-- +-- Changes to the response made inside the inner 'GHandler' are +-- ignored (e.g., session variables, cookies, response headers). +-- This allows the inner 'GHandler' to outlive the outer +-- 'GHandler' (e.g., on the @forkIO@ example above, a response +-- may be sent to the client without killing the new thread). +handlerToIO :: MonadIO m => GHandler sub master (GHandler sub master a -> m a) +handlerToIO = + GHandler $ \oldHandlerData -> do + -- Let go of the request body, cache and response headers. + let oldReq = handlerRequest oldHandlerData + oldWaiReq = reqWaiRequest oldReq + newWaiReq = oldWaiReq { W.requestBody = sourceList [] } + newReq = oldReq { reqWaiRequest = newWaiReq + , reqBodySize = 0 } + newState <- liftIO $ do + oldState <- I.readIORef (handlerState oldHandlerData) + return $ oldState { ghsRBC = Nothing + , ghsIdent = 1 + , ghsCache = mempty + , ghsHeaders = mempty } + + -- Return GHandler running function. + return $ \(GHandler f) -> liftIO $ do + -- The state IORef needs to be created here, otherwise it + -- will be shared by different invocations of this function. + newStateIORef <- I.newIORef newState + runResourceT $ f oldHandlerData { handlerRequest = newReq + , handlerState = newStateIORef } + + -- | Function used internally by Yesod in the process of converting a -- 'GHandler' into an 'W.Application'. Should not be needed by users. runHandler :: HasReps c From 786b5bc6e27b54d521fa0b77d0fc98d100f154ef Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 20 Aug 2012 13:09:43 -0300 Subject: [PATCH 2/3] yesod-core: On handlerToIO's docs, avoid shadowing a name. --- yesod-core/Yesod/Handler.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index e6775471..89231650 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -403,8 +403,8 @@ getRouteToMaster = handlerToMaster `liftM` ask -- @ -- getFooR :: Handler RepHtml -- getFooR = do --- runHandler <- handlerToIO --- liftIO $ forkIO $ runHandler $ do +-- runInnerHandler <- handlerToIO +-- liftIO $ forkIO $ runInnerHandler $ do -- /Code here runs inside GHandler but on a new thread./ -- /This is the inner GHandler./ -- ... From dc14783c818cbe3cd198e122f3481ba5b8ce2cd9 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 20 Aug 2012 13:13:46 -0300 Subject: [PATCH 3/3] yesod-core: On handlerToIO, avoid 'sourceList []'. --- yesod-core/Yesod/Handler.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/yesod-core/Yesod/Handler.hs b/yesod-core/Yesod/Handler.hs index 89231650..811d8f54 100644 --- a/yesod-core/Yesod/Handler.hs +++ b/yesod-core/Yesod/Handler.hs @@ -178,7 +178,6 @@ import Control.Exception.Lifted (catch) import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Control.Monad.Base -import Data.Conduit.List (sourceList) import Yesod.Routes.Class import Data.Word (Word64) import Language.Haskell.TH.Syntax (Loc) @@ -436,7 +435,7 @@ handlerToIO = -- Let go of the request body, cache and response headers. let oldReq = handlerRequest oldHandlerData oldWaiReq = reqWaiRequest oldReq - newWaiReq = oldWaiReq { W.requestBody = sourceList [] } + newWaiReq = oldWaiReq { W.requestBody = mempty } newReq = oldReq { reqWaiRequest = newWaiReq , reqBodySize = 0 } newState <- liftIO $ do