withDevelAppPort to getApplicationDev, no more Dynamic

This commit is contained in:
Michael Snoyman 2012-01-23 21:57:59 +02:00
parent adecd25bc3
commit abd23e57df
4 changed files with 20 additions and 29 deletions

View File

@ -7,7 +7,7 @@ module Yesod.Default.Main
) where ) where
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Logger (Logger, defaultDevelopmentLogger, logString, flushLogger) import Yesod.Logger (Logger, defaultDevelopmentLogger, logString)
import Network.Wai (Application) import Network.Wai (Application)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort, settingsHost) (runSettings, defaultSettings, settingsPort, settingsHost)
@ -82,20 +82,15 @@ defaultRunner f app = do
-- | Run your development app using a custom environment type and loader -- | Run your development app using a custom environment type and loader
-- function -- function
--
-- > withDevelAppPort :: Dynamic
-- > withDevelAppPort = toDyn $ defaultDevelApp customLoadAppConfig withMySite
--
defaultDevelApp defaultDevelApp
:: (Show env, Read env) :: (Show env, Read env)
=> IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@
-> (AppConfig env extra -> Logger -> IO Application) -- ^ Get your @Application@ -> (AppConfig env extra -> Logger -> IO Application) -- ^ Get your @Application@
-> ((Int, Application) -> IO ()) -> IO () -> IO (Int, Application)
defaultDevelApp load getApp f = do defaultDevelApp load getApp = do
conf <- load conf <- load
logger <- defaultDevelopmentLogger logger <- defaultDevelopmentLogger
let p = appPort conf let p = appPort conf
logString logger $ "Devel application launched, listening on port " ++ show p logString logger $ "Devel application launched, listening on port " ++ show p
app <- getApp conf logger app <- getApp conf logger
f (p, app) return (p, app)
flushLogger logger

View File

@ -159,11 +159,9 @@ showPkgName = (\(D.PackageName n) -> n) . D.pkgName
develFile :: D.PackageId -> T.Text develFile :: D.PackageId -> T.Text
develFile pid = [ST| develFile pid = [ST|
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
import "#{showPkgName pid}" Application (withDevelAppPort) import "#{showPkgName pid}" Application (getApplicationDev)
import Data.Dynamic (fromDynamic)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort, settingsHost) (runSettings, defaultSettings, settingsPort, settingsHost)
import Data.Maybe (fromJust)
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO)
import System.Directory (doesFileExist, removeFile) import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
@ -171,13 +169,13 @@ import Control.Concurrent (threadDelay)
main :: IO () main :: IO ()
main = do main = do
putStrLn "Starting devel application" putStrLn "Starting devel application"
wdap <- (return . fromJust . fromDynamic) withDevelAppPort (port, app) <- getApplicationDev
forkIO . wdap $ \(port, app) -> runSettings defaultSettings forkIO $ runSettings defaultSettings
{ settingsPort = port { settingsPort = port
, settingsHost = "0.0.0.0" , settingsHost = "0.0.0.0"
} app } app
loop loop
loop :: IO () loop :: IO ()
loop = do loop = do

View File

@ -1,7 +1,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Application module Application
( getApplication ( getApplication
, withDevelAppPort , getApplicationDev
) where ) where
import Import import Import
@ -11,7 +11,6 @@ import Yesod.Auth
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Main import Yesod.Default.Main
import Yesod.Default.Handlers import Yesod.Default.Handlers
import Data.Dynamic (Dynamic, toDyn)
#if DEVELOPMENT #if DEVELOPMENT
import Yesod.Logger (Logger, logBS) import Yesod.Logger (Logger, logBS)
import Network.Wai.Middleware.RequestLogger (logHandleDev) import Network.Wai.Middleware.RequestLogger (logHandleDev)
@ -55,9 +54,9 @@ getApplication conf logger = do
#endif #endif
-- for yesod devel -- for yesod devel
withDevelAppPort :: Dynamic getApplicationDev :: IO (Int, Application)
withDevelAppPort = getApplicationDev =
toDyn $ defaultDevelApp loader getApplication defaultDevelApp loader getApplication
where where
loader = loadConfig (configSettings Development) loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra { csParseExtra = parseExtra

View File

@ -1,7 +1,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Application module Application
( getApplication ( getApplication
, withDevelAppPort , getApplicationDev
) where ) where
import Import import Import
@ -18,7 +18,6 @@ import Yesod.Logger (Logger, logBS, toProduction)
import Network.Wai.Middleware.RequestLogger (logHandle) import Network.Wai.Middleware.RequestLogger (logHandle)
#endif #endif
import Network.Wai (Application) import Network.Wai (Application)
import Data.Dynamic (Dynamic, toDyn)
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
import Handler.Root import Handler.Root
@ -48,9 +47,9 @@ getApplication conf logger = do
#endif #endif
-- for yesod devel -- for yesod devel
withDevelAppPort :: Dynamic getApplicationDev :: IO (Int, Application)
withDevelAppPort = getApplicationDev =
toDyn $ defaultDevelApp loader getApplication defaultDevelApp loader getApplication
where where
loader = loadConfig (configSettings Development) loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra { csParseExtra = parseExtra