From b8a73d9b7f8f33e7bd1df38aa903c3eefa468bf3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 10 Apr 2014 15:04:29 +0300
Subject: [PATCH] defaultMiddlewares and MonadCatch instance

---
 yesod-core/Yesod/Core/Dispatch.hs | 13 ++++++++-----
 yesod-core/Yesod/Core/Types.hs    | 10 ++++++++++
 yesod-core/yesod-core.cabal       |  3 ++-
 3 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs
index 1f50d035..59663a8f 100644
--- a/yesod-core/Yesod/Core/Dispatch.hs
+++ b/yesod-core/Yesod/Core/Dispatch.hs
@@ -27,6 +27,7 @@ module Yesod.Core.Dispatch
     , warpDebug
     , warpEnv
     , mkDefaultMiddlewares
+    , defaultMiddlewaresNoLogging
       -- * WAI subsites
     , WaiSubsite (..)
     ) where
@@ -194,11 +195,13 @@ mkDefaultMiddlewares logger = do
 #endif
         , outputFormat = Apache FromSocket
         }
-    return $ logWare
-           . acceptOverride
-           . autohead
-           . gzip def
-           . methodOverride
+    return $ logWare . defaultMiddlewaresNoLogging
+
+-- | All of the default middlewares, excluding logging.
+--
+-- Since 1.2.12
+defaultMiddlewaresNoLogging :: W.Middleware
+defaultMiddlewaresNoLogging = acceptOverride . autohead . gzip def . methodOverride
 
 -- | Deprecated synonym for 'warp'.
 warpDebug :: YesodDispatch site => Int -> site -> IO ()
diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs
index b0e2c79e..01f52798 100644
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@@ -16,6 +16,7 @@ import           Control.Arrow                      (first)
 import           Control.Exception                  (Exception)
 import           Control.Monad                      (liftM, ap)
 import           Control.Monad.Base                 (MonadBase (liftBase))
+import           Control.Monad.Catch                (MonadCatch (..))
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel, LogSource,
                                                      MonadLogger (..))
@@ -62,6 +63,7 @@ import           Yesod.Core.Internal.Util           (getTime, putTime)
 import           Control.Monad.Trans.Class          (MonadTrans (..))
 import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
 import           Control.Monad.Reader               (MonadReader (..))
+import Prelude hiding (catch)
 
 -- Sessions
 type SessionMap = Map Text ByteString
@@ -405,6 +407,14 @@ instance MonadTrans (WidgetT site) where
 instance MonadThrow m => MonadThrow (WidgetT site m) where
 #if MIN_VERSION_resourcet(1,1,0)
     throwM = lift . throwM
+
+instance MonadCatch m => MonadCatch (HandlerT site m) where
+  catch (HandlerT m) c = HandlerT $ \r -> m r `catch` \e -> unHandlerT (c e) r
+  mask a = HandlerT $ \e -> mask $ \u -> unHandlerT (a $ q u) e
+    where q u (HandlerT b) = HandlerT (u . b)
+  uninterruptibleMask a =
+    HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
+      where q u (HandlerT b) = HandlerT (u . b)
 #else
     monadThrow = lift . monadThrow
 #endif
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index c2c927dd..a6b8d7e7 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         1.2.11.1
+version:         1.2.12
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -68,6 +68,7 @@ library
                    , warp                  >= 1.3.8
                    , unix-compat
                    , conduit-extra
+                   , exceptions
 
     exposed-modules: Yesod.Core
                      Yesod.Core.Content