yesodWithInternalState

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.
 --

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

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 <michael@snoyman.com>