Merge remote-tracking branch 'origin/master' into wai-2.0

yesod-core/Yesod/Core/Class/Handler.hs

@@ -41,7 +41,7 @@ replaceToParent hd = hd { handlerToParent = const () }
 instance MonadResourceBase m => MonadHandler (HandlerT site m) where
     type HandlerSite (HandlerT site m) = site
     liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent
-{-# RULES "liftHandlerT (HandlerT site IO)" forall action. liftHandlerT action = id #-}
+{-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-}
 
 instance MonadResourceBase m => MonadHandler (WidgetT site m) where
     type HandlerSite (WidgetT site m) = site

yesod-persistent/Yesod/Persist/Core.hs

@@ -28,6 +28,8 @@ import Blaze.ByteString.Builder (Builder)
 import Data.IORef.Lifted
 import Data.Conduit.Pool
 import Control.Monad.Trans.Resource
+import Control.Exception (throwIO)
+import Yesod.Core.Types (HandlerContents (HCError))
 import qualified Database.Persist.Sql as SQL
 
 type YesodDB site = YesodPersistBackend site (HandlerT site IO)
@@ -132,7 +134,7 @@ get404 :: ( PersistStore (t m)
 get404 key = do
     mres <- get key
     case mres of
-        Nothing -> lift notFound
+        Nothing -> notFound'
         Just res -> return res
 
 -- | Get the given entity by unique key, or return a 404 not found if it doesn't
@@ -148,9 +150,14 @@ getBy404 :: ( PersistUnique (t m)
 getBy404 key = do
     mres <- getBy key
     case mres of
-        Nothing -> lift notFound
+        Nothing -> notFound'
         Just res -> return res
 
+-- | Should be equivalent to @lift . notFound@, but there's an apparent bug in
+-- GHC 7.4.2 that leads to segfaults. This is a workaround.
+notFound' :: MonadIO m => m a
+notFound' = liftIO $ throwIO $ HCError NotFound
+
 instance MonadHandler m => MonadHandler (SqlPersistT m) where
     type HandlerSite (SqlPersistT m) = HandlerSite m
     liftHandlerT = lift . liftHandlerT