From bd6671b2640049986a2cf429abac5fa73e1c034c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 12 Jan 2012 09:52:06 +0200 Subject: [PATCH] Less inversion of control --- .gitmodules | 3 ++ http-conduit | 1 + package-list.sh | 1 + yesod-default/Yesod/Default/Main.hs | 58 +++++++++++---------------- yesod/Scaffolding/Scaffolder.hs | 2 +- yesod/scaffold/Application.hs.cg | 18 +++++---- yesod/scaffold/main.hs.cg | 4 +- yesod/scaffold/tiny/Application.hs.cg | 27 +++++++++---- yesod/scaffold/tiny/Foundation.hs.cg | 5 +-- yesod/scaffold/tiny/project.cabal.cg | 1 + 10 files changed, 64 insertions(+), 56 deletions(-) create mode 160000 http-conduit diff --git a/.gitmodules b/.gitmodules index 5f97538c..a9aec3b0 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,6 @@ [submodule "authenticate"] path = authenticate url = https://github.com/yesodweb/authenticate.git +[submodule "http-conduit"] + path = http-conduit + url = https://github.com/snoyberg/http-conduit.git diff --git a/http-conduit b/http-conduit new file mode 160000 index 00000000..7d67c7d7 --- /dev/null +++ b/http-conduit @@ -0,0 +1 @@ +Subproject commit 7d67c7d78b2ba29639554d9d69d6b00dd98367fc diff --git a/package-list.sh b/package-list.sh index 41b38a9c..1b7dd6c4 100644 --- a/package-list.sh +++ b/package-list.sh @@ -7,6 +7,7 @@ pkgs=( ./yesod-routes ./yesod-persistent ./yesod-newsfeed ./yesod-form + ./http-conduit ./authenticate ./yesod-auth ./yesod-sitemap diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs index a7feb1cf..ff88b866 100644 --- a/yesod-default/Yesod/Default/Main.hs +++ b/yesod-default/Yesod/Default/Main.hs @@ -4,10 +4,8 @@ module Yesod.Default.Main ( defaultMain , defaultRunner , defaultDevelApp - , defaultDevelAppWith ) where -import Yesod.Core import Yesod.Default.Config import Yesod.Logger (Logger, makeDefaultLogger, logString, flushLogger) import Network.Wai (Application) @@ -41,15 +39,16 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -- defaultMain :: (Show env, Read env) => IO (AppConfig env extra) - -> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ()) + -> (AppConfig env extra -> Logger -> IO Application) -> IO () -defaultMain load withSite = do +defaultMain load getApp = do config <- load logger <- makeDefaultLogger - withSite config logger $ runSettings defaultSettings + app <- getApp config logger + runSettings defaultSettings { settingsHost = "0.0.0.0" , settingsPort = appPort config - } + } app -- | Run your application continously, listening for SIGINT and exiting -- when recieved @@ -59,18 +58,15 @@ defaultMain load withSite = do -- > Settings.withConnectionPool conf $ \p -> do -- > runConnectionPool (runMigration yourMigration) p -- > defaultRunner f $ YourSite conf logger p -defaultRunner :: (YesodDispatch y y, Yesod y) - => (Application -> IO a) - -> y -- ^ your foundation type - -> IO () -defaultRunner f h = do +defaultRunner :: (Application -> IO ()) -> Application -> IO () +defaultRunner f app = do -- clear the .static-cache so we don't have stale content exists <- doesDirectoryExist staticCache when exists $ removeDirectoryRecursive staticCache #ifdef WINDOWS - toWaiAppPlain h >>= f . middlewares >> return () + f (middlewares app) #else - tid <- forkIO $ toWaiAppPlain h >>= f . middlewares >> return () + tid <- forkIO $ f (middlewares app) >> return () flag <- newEmptyMVar _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do putStrLn "Caught an interrupt" @@ -84,30 +80,22 @@ defaultRunner f h = do gset = def { gzipFiles = GzipCacheFolder staticCache } staticCache = ".static-cache" --- | Run your development app using the provided @'DefaultEnv'@ type --- --- > withDevelAppPort :: Dynamic --- > withDevelAppPort = toDyn $ defaultDevelApp withMySite --- -defaultDevelApp :: (AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()) - -> ((Int, Application) -> IO ()) - -> IO () -defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig - -- | Run your development app using a custom environment type and loader -- function -- -- > withDevelAppPort :: Dynamic --- > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite +-- > withDevelAppPort = toDyn $ defaultDevelApp customLoadAppConfig withMySite -- -defaultDevelAppWith :: (Show env, Read env) - => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ - -> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function - -> ((Int, Application) -> IO ()) -> IO () -defaultDevelAppWith load withSite f = do - conf <- load - logger <- makeDefaultLogger - let p = appPort conf - logString logger $ "Devel application launched, listening on port " ++ show p - withSite conf logger $ \app -> f (p, app) - flushLogger logger +defaultDevelApp + :: (Show env, Read env) + => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ + -> (AppConfig env extra -> Logger -> IO Application) -- ^ Get your @Application@ + -> ((Int, Application) -> IO ()) -> IO () +defaultDevelApp load getApp f = do + conf <- load + logger <- makeDefaultLogger + let p = appPort conf + logString logger $ "Devel application launched, listening on port " ++ show p + app <- getApp conf logger + f (p, app) + flushLogger logger diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index 9777d900..6d79df51 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/yesod/Scaffolding/Scaffolder.hs @@ -84,7 +84,7 @@ scaffold = do let runMigration = case backend of MongoDB -> "" - _ -> "\n Database.Persist.Store.runPool dbconf (runMigration migrateAll) p" + _ -> "\n Database.Persist.Store.runPool dbconf (runMigration migrateAll) p" let importMigration = case backend of diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 8ba6dee9..dd8fdbf8 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Application - ( with~sitearg~ + ( getApplication , withDevelAppPort ) where @@ -20,7 +20,7 @@ import Yesod.Logger (Logger) import Network.Wai.Middleware.RequestLogger (logStdout) #endif import qualified Database.Persist.Store~importMigration~ -import Network.HTTP.Conduit (withManager) +import Network.HTTP.Conduit (newManagerIO) -- Import all relevant handler modules here. import Handler.Root @@ -34,14 +34,16 @@ mkYesodDispatch "~sitearg~" resources~sitearg~ -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -with~sitearg~ :: AppConfig DefaultEnv Extra -> Logger -> (Application -> IO ()) -> IO () -with~sitearg~ conf logger f = withManager $ \manager -> lift $ do +getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application +getApplication conf logger = do + manager <- newManagerIO 10 s <- staticSite dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf) Database.Persist.Store.loadConfig - Database.Persist.Store.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~ - let h = ~sitearg~ conf logger s p manager - defaultRunner (f . logWare) h + p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~ + let foundation = ~sitearg~ conf logger s p manager + app <- toWaiAppPlain foundation + return $ logWare app where #ifdef DEVELOPMENT logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger) @@ -52,7 +54,7 @@ with~sitearg~ conf logger f = withManager $ \manager -> lift $ do -- for yesod devel withDevelAppPort :: Dynamic withDevelAppPort = - toDyn $ defaultDevelAppWith loader with~sitearg~ + toDyn $ defaultDevelApp loader getApplication where loader = loadConfig (configSettings Development) { csParseExtra = parseExtra diff --git a/yesod/scaffold/main.hs.cg b/yesod/scaffold/main.hs.cg index 6238c204..e05f4925 100644 --- a/yesod/scaffold/main.hs.cg +++ b/yesod/scaffold/main.hs.cg @@ -2,7 +2,7 @@ import Prelude (IO) import Yesod.Default.Config (fromArgsExtra) import Yesod.Default.Main (defaultMain) import Settings (parseExtra) -import Application (with~sitearg~) +import Application (getApplication) main :: IO () -main = defaultMain (fromArgsExtra parseExtra) with~sitearg~ +main = defaultMain (fromArgsExtra parseExtra) getApplication diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index 95ea820b..275c738b 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Application - ( with~sitearg~ + ( getApplication , withDevelAppPort ) where @@ -8,9 +8,15 @@ import Import import Settings (parseExtra) import Settings.StaticFiles (staticSite) import Yesod.Default.Config -import Yesod.Default.Main (defaultDevelAppWith, defaultRunner) +import Yesod.Default.Main (defaultDevelApp) import Yesod.Default.Handlers (getFaviconR, getRobotsR) +#if DEVELOPMENT +import Yesod.Logger (Logger, logBS, flushLogger) +import Network.Wai.Middleware.RequestLogger (logHandleDev) +#else import Yesod.Logger (Logger) +import Network.Wai.Middleware.RequestLogger (logStdout) +#endif import Network.Wai (Application) import Data.Dynamic (Dynamic, toDyn) @@ -26,16 +32,23 @@ mkYesodDispatch "~sitearg~" resources~sitearg~ -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -with~sitearg~ :: AppConfig DefaultEnv Extra -> Logger -> (Application -> IO ()) -> IO () -with~sitearg~ conf logger f = do +getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application +getApplication conf logger = do s <- staticSite - let h = ~sitearg~ conf logger s - defaultRunner f h + let foundation = ~sitearg~ conf logger s + app <- toWaiAppPlain foundation + return $ logWare app + where +#ifdef DEVELOPMENT + logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger) +#else + logWare = logStdout +#endif -- for yesod devel withDevelAppPort :: Dynamic withDevelAppPort = - toDyn $ defaultDevelAppWith loader with~sitearg~ + toDyn $ defaultDevelApp loader getApplication where loader = loadConfig (configSettings Development) { csParseExtra = parseExtra diff --git a/yesod/scaffold/tiny/Foundation.hs.cg b/yesod/scaffold/tiny/Foundation.hs.cg index 6abfb69d..2ab861c2 100644 --- a/yesod/scaffold/tiny/Foundation.hs.cg +++ b/yesod/scaffold/tiny/Foundation.hs.cg @@ -1,13 +1,12 @@ module Foundation ( ~sitearg~ (..) - , ~sitearg~Route (..) + , Route (..) , ~sitearg~Message (..) , resources~sitearg~ , Handler , Widget , module Yesod.Core , module Settings - , StaticRoute (..) , liftIO ) where @@ -15,7 +14,7 @@ import Prelude import Yesod.Core import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Static (Static, base64md5, StaticRoute(..)) +import Yesod.Static import Settings.StaticFiles import Yesod.Logger (Logger, logMsg, formatLogText) import qualified Settings diff --git a/yesod/scaffold/tiny/project.cabal.cg b/yesod/scaffold/tiny/project.cabal.cg index 3e38d418..7bd4ae6f 100644 --- a/yesod/scaffold/tiny/project.cabal.cg +++ b/yesod/scaffold/tiny/project.cabal.cg @@ -76,6 +76,7 @@ executable ~project~ , hamlet >= 0.10 && < 0.11 , shakespeare-text >= 0.10 && < 0.11 , wai >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 , transformers >= 0.2 && < 0.3 , monad-control >= 0.3 && < 0.4 , yaml >= 0.5 && < 0.6