diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 25a11146..5dbaff24 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -14,10 +14,12 @@ import Yesod.Routes.Class import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) import Control.Arrow ((***), second) +import Control.Exception (bracket) import Control.Monad (forM, when, void) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource) +import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Aeson (object, (.=)) @@ -284,6 +286,20 @@ class RenderRoute site => Yesod site where yesodMiddleware :: ToTypedContent res => HandlerT site IO res -> HandlerT site IO res yesodMiddleware = defaultYesodMiddleware + -- | How to allocate an @InternalState@ for each request. + -- + -- The default implementation is almost always what you want. However, if + -- you know that you are never taking advantage of the @MonadResource@ + -- instance in your handler functions, setting this to a dummy + -- implementation can provide a small optimization. Only do this if you + -- really know what you're doing, otherwise you can turn safe code into a + -- runtime error! + -- + -- Since 1.4.2 + yesodWithInternalState :: site -> Maybe (Route site) -> (InternalState -> IO a) -> IO a + yesodWithInternalState _ _ = bracket createInternalState closeInternalState + {-# INLINE yesodWithInternalState #-} + -- | Default implementation of 'yesodMiddleware'. Adds the response header -- \"Vary: Accept, Accept-Language\" and performs authorization checks. -- diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index ec1c4668..fdb22618 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -18,7 +18,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LogLevel (LevelError), LogSource, liftLoc) -import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) +import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.IORef as I @@ -278,7 +278,7 @@ yesodRunner handler' YesodRunnerEnv {..} route req sendResponse { rheOnError = runHandler rheSafe . errorHandler } - E.bracket createInternalState closeInternalState $ \is -> do + yesodWithInternalState yreSite route $ \is -> do yreq' <- yreq yar <- runInternalState (runHandler rhe handler yreq') is yarToResponse yar saveSession yreq' req is sendResponse diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 5c9ff816..1448e6ff 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.1.1 +version: 1.4.2 license: MIT license-file: LICENSE author: Michael Snoyman