diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index df822e2d..e6f489da 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -41,7 +41,7 @@ import qualified Network.Wai as W import Data.ByteString.Lazy.Char8 () -import Data.Text (Text) +import Data.Text (Text, pack) import Data.Monoid (mappend) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -118,6 +118,10 @@ toWaiAppYre yre req = toWaiApp :: YesodDispatch site => site -> IO W.Application toWaiApp site = do logger <- makeLogger site + toWaiAppLogger logger site + +toWaiAppLogger :: YesodDispatch site => Logger -> site -> IO W.Application +toWaiAppLogger logger site = do sb <- makeSessionBackend site let yre = YesodRunnerEnv { yreLogger = logger @@ -144,19 +148,29 @@ toWaiApp site = do -- -- Since 1.2.0 warp :: YesodDispatch site => Int -> site -> IO () -warp port site = toWaiApp site >>= Network.Wai.Handler.Warp.runSettings - Network.Wai.Handler.Warp.defaultSettings - { Network.Wai.Handler.Warp.settingsPort = port - {- FIXME - , Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat - [ "Warp/" - , Network.Wai.Handler.Warp.warpVersion - , " + Yesod/" - , showVersion Paths_yesod_core.version - , " (core)" - ] - -} - } +warp port site = do + logger <- makeLogger site + toWaiAppLogger logger site >>= Network.Wai.Handler.Warp.runSettings + Network.Wai.Handler.Warp.defaultSettings + { Network.Wai.Handler.Warp.settingsPort = port + {- FIXME + , Network.Wai.Handler.Warp.settingsServerName = S8.pack $ concat + [ "Warp/" + , Network.Wai.Handler.Warp.warpVersion + , " + Yesod/" + , showVersion Paths_yesod_core.version + , " (core)" + ] + -} + , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> + messageLoggerSource + site + logger + $(qLocation >>= liftLoc) + "yesod-core" + LevelError + (toLogStr $ "Exception from Warp: " ++ show e) + } -- | A default set of middlewares. --