diff --git a/yesod/Yesod/Default/Main.hs b/yesod/Yesod/Default/Main.hs index 955aa7a6..0780539a 100644 --- a/yesod/Yesod/Default/Main.hs +++ b/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 -- diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 88aff16b..1d3f5ee8 100644 --- a/yesod/yesod.cabal +++ b/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 @@ -46,6 +46,8 @@ library , directory , template-haskell , bytestring + , monad-logger + , fast-logger exposed-modules: Yesod , Yesod.Default.Config