haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #968 from rdesfo/master

Browse Source 
updated deprecated settingsPort, settingsHost, settingsOnException
This commit is contained in:
Michael Snoyman 2015-04-13 21:09:32 +03:00
commit 4bc0ad96fe
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
yesod/Yesod/Default/Main.hs
View File

@ -13,7 +13,7 @@ module Yesod.Default.Main
import Yesod.Default.Config import Yesod.Default.Config
import Network.Wai (Application) import Network.Wai (Application)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort, settingsHost, settingsOnException) (runSettings, defaultSettings, setPort, setHost, setOnException)
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def) import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def)
@ -48,10 +48,11 @@ defaultMain :: (Show env, Read env)
defaultMain load getApp = do defaultMain load getApp = do
config <- load config <- load
app <- getApp config app <- getApp config
runSettings defaultSettings runSettings
{ settingsPort = appPort config ( setPort (appPort config)
, settingsHost = appHost config $ setHost (appHost config)
} app $ defaultSettings
) app
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
@ -66,15 +67,16 @@ defaultMainLog :: (Show env, Read env)
defaultMainLog load getApp = do defaultMainLog load getApp = do
config <- load config <- load
(app, logFunc) <- getApp config (app, logFunc) <- getApp config
runSettings defaultSettings runSettings
{ settingsPort = appPort config ( setPort (appPort config)
, settingsHost = appHost config $ setHost (appHost config)
, settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc $ setOnException (const $ \e -> when (shouldLog' e) $ logFunc
$(qLocation >>= liftLoc) $(qLocation >>= liftLoc)
"yesod" "yesod"
LevelError LevelError
(toLogStr $ "Exception from Warp: " ++ show e) (toLogStr $ "Exception from Warp: " ++ show e))
} app $ defaultSettings
) app
where where
shouldLog' = Warp.defaultShouldDisplayException shouldLog' = Warp.defaultShouldDisplayException