defaultMainLog

yesod/Yesod/Default/Main.hs

@@ -1,15 +1,19 @@
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE TemplateHaskell    #-}
 module Yesod.Default.Main
     ( defaultMain
+    , defaultMainLog
     , defaultRunner
     , defaultDevelApp
+    , LogFunc
     ) where
 
 import Yesod.Default.Config
 import Network.Wai (Application)
 import Network.Wai.Handler.Warp
-    (runSettings, defaultSettings, settingsPort, settingsHost)
+    (runSettings, defaultSettings, settingsPort, settingsHost, settingsOnException)
 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def)
 import Network.Wai.Middleware.Autohead (autohead)
@@ -18,6 +22,9 @@ import Control.Monad (when)
 import System.Environment (getEnvironment)
 import Data.Maybe (fromMaybe)
 import Safe (readMay)
+import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc)
+import System.Log.FastLogger (LogStr, toLogStr)
+import Language.Haskell.TH.Syntax (qLocation)
 
 #ifndef WINDOWS
 import qualified System.Posix.Signals as Signal
@@ -45,6 +52,29 @@ defaultMain load getApp = do
         , settingsHost = appHost config
         } app
 
+type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
+
+-- | Same as @defaultMain@, but gets a logging function back as well as an
+-- @Application@ to install Warp exception handlers.
+--
+-- Since 1.2.5
+defaultMainLog :: (Show env, Read env)
+               => IO (AppConfig env extra)
+               -> (AppConfig env extra -> IO (Application, LogFunc))
+               -> IO ()
+defaultMainLog load getApp = do
+    config <- load
+    (app, logFunc) <- getApp config
+    runSettings defaultSettings
+        { settingsPort = appPort config
+        , settingsHost = appHost config
+        , settingsOnException = const $ \e -> logFunc
+            $(qLocation >>= liftLoc)
+            "yesod"
+            LevelError
+            (toLogStr $ "Exception from Warp: " ++ show e)
+        } app
+
 -- | Run your application continously, listening for SIGINT and exiting
 --   when received
 --

yesod/yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         1.2.4
+version:         1.2.5
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -46,6 +46,8 @@ library
                    , directory
                    , template-haskell
                    , bytestring
+                   , monad-logger
+                   , fast-logger
 
     exposed-modules: Yesod
                    , Yesod.Default.Config