Remainder of Logger changes, scaffolded site works (#360)
This commit is contained in:
parent
ddd1059983
commit
985dd6c924
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user