Remainder of Logger changes, scaffolded site works (#360)

This commit is contained in:
Michael Snoyman 2012-07-05 13:37:54 +03:00
parent ddd1059983
commit 985dd6c924
6 changed files with 19 additions and 49 deletions

View File

@ -7,7 +7,6 @@ module Yesod.Default.Main
) where
import Yesod.Default.Config
import Yesod.Logger (Logger, defaultDevelopmentLogger, logString)
import Network.Wai (Application)
import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort, settingsHost)
@ -33,12 +32,11 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
--
defaultMain :: (Show env, Read env)
=> IO (AppConfig env extra)
-> (AppConfig env extra -> Logger -> IO Application)
-> (AppConfig env extra -> IO Application)
-> IO ()
defaultMain load getApp = do
config <- load
logger <- defaultDevelopmentLogger
app <- getApp config logger
app <- getApp config
print $ appHost config
runSettings defaultSettings
{ settingsPort = appPort config
@ -80,12 +78,11 @@ defaultRunner f app = do
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@
-> (AppConfig env extra -> IO Application) -- ^ Get your @Application@
-> IO (Int, Application)
defaultDevelApp load getApp = do
conf <- load
logger <- defaultDevelopmentLogger
let p = appPort conf
logString logger $ "Devel application launched: http://localhost:" ++ show p
app <- getApp conf logger
putStrLn $ "Devel application launched: http://localhost:" ++ show p
app <- getApp conf
return (p, app)

View File

@ -138,10 +138,10 @@ instance RenderRoute Static where
instance Yesod master => YesodDispatch Static master where
-- Need to append trailing slash to make relative links work
yesodDispatch _ _ _ _ _ _ [] _ req =
yesodDispatch _ _ _ _ _ _ _ [] _ req =
return $ responseLBS status301 [("Location", rawPathInfo req `S.append` "/")] ""
yesodDispatch _ (Static set) _ _ _ _ textPieces _ req =
yesodDispatch _ _ (Static set) _ _ _ _ textPieces _ req =
staticApp set req { pathInfo = textPieces }
notHidden :: Prelude.FilePath -> Bool

View File

@ -45,15 +45,13 @@ import Text.Julius
import Yesod.Form
import Yesod.Json
import Yesod.Persist
import Network.HTTP.Types (status200)
import Control.Monad.IO.Class (liftIO, MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl)
import Network.Wai
import Network.Wai.Logger
import Network.Wai.Middleware.RequestLogger (logStdout)
import Network.Wai.Handler.Warp (run)
import System.IO (stderr, stdout, hFlush, hPutStrLn)
import System.Log.FastLogger
import System.IO (stderr, hPutStrLn)
#if MIN_VERSION_blaze_html(0, 5, 0)
import Text.Blaze.Html (toHtml)
#else
@ -80,23 +78,7 @@ warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
warpDebug port app = do
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
waiApp <- toWaiApp app
dateRef <- dateInit
run port $ (logStdout dateRef) waiApp
logStdout :: DateRef -> Middleware
logStdout dateRef waiApp =
\req -> do
logRequest dateRef req
waiApp req
logRequest :: Control.Monad.IO.Class.MonadIO m =>
DateRef -> Network.Wai.Request -> m ()
logRequest dateRef req = do
date <- liftIO $ getDate dateRef
let status = status200
len = 4
liftIO $ hPutLogStr stdout $ apacheFormat FromSocket date req status (Just len)
liftIO $ hFlush stdout
run port $ logStdout waiApp
-- | Run a development server, where your code changes are automatically
-- reloaded.

View File

@ -11,8 +11,7 @@ import Yesod.Auth
import Yesod.Default.Config
import Yesod.Default.Main
import Yesod.Default.Handlers
import Yesod.Logger (Logger, logBS, toProduction)
import Network.Wai.Middleware.RequestLogger (logCallback, logCallbackDev)
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import qualified Database.Persist.Store~importMigration~
import Network.HTTP.Conduit (newManager, def)
@ -29,25 +28,24 @@ 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.
makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
makeApplication conf logger = do
foundation <- makeFoundation conf setLogger
makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
return $ logWare app
where
setLogger = if development then logger else toProduction logger
logWare = if development then logCallbackDev (logBS setLogger)
else logCallback (logBS setLogger)
logWare = if development then logStdoutDev
else logStdout
makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~
makeFoundation conf setLogger = do
makeFoundation :: AppConfig DefaultEnv Extra -> IO ~sitearg~
makeFoundation conf = do
manager <- newManager def
s <- staticSite
dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
Database.Persist.Store.loadConfig >>=
Database.Persist.Store.applyEnv
p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~
return $ ~sitearg~ conf setLogger s p manager dbconf
return $ ~sitearg~ conf s p manager dbconf
-- for yesod devel
getApplicationDev :: IO (Int, Application)

View File

@ -20,7 +20,6 @@ import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail
import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Logger (Logger, logMsg, formatLogText)
import Network.HTTP.Conduit (Manager)
import qualified Settings
import qualified Database.Persist.Store
@ -38,7 +37,6 @@ import Text.Hamlet (hamletFile)
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ settings :: AppConfig DefaultEnv Extra
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.
, httpManager :: Manager
@ -107,9 +105,6 @@ instance Yesod ~sitearg~ where
-- The page to be redirected to when authentication is required.
authRoute _ = Just $ AuthR LoginR
messageLogger y loc level msg =
formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y)
-- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of

View File

@ -74,7 +74,6 @@ library
, transformers >= 0.2.2 && < 0.4
, wai >= 1.3 && < 1.4
, wai-extra >= 1.3 && < 1.4
, wai-logger >= 0.1.2
, hamlet >= 1.1 && < 1.2
, shakespeare-js >= 1.0 && < 1.1
, shakespeare-css >= 1.0 && < 1.1
@ -103,7 +102,6 @@ executable yesod
, http-types >= 0.6.1 && < 0.7
, blaze-builder >= 0.2.1.4 && < 0.4
, filepath >= 1.1
, fast-logger >= 0.0.2 && < 0.1
, process
ghc-options: -Wall -threaded
main-is: main.hs