Less inversion of control

.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

http-conduit

@@ -0,0 +1 @@
+Subproject commit 7d67c7d78b2ba29639554d9d69d6b00dd98367fc

package-list.sh

@@ -7,6 +7,7 @@ pkgs=(      ./yesod-routes
             ./yesod-persistent
             ./yesod-newsfeed
             ./yesod-form
+            ./http-conduit
             ./authenticate
             ./yesod-auth
             ./yesod-sitemap

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

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

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

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

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

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

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