Use wai-logger in warpDebug.

This solves issue 205: https://github.com/yesodweb/yesod/issues/205
This commit is contained in:
Issac Trotts 2012-01-16 13:43:06 -08:00
parent 895bb7666b
commit dd73e6ca01
2 changed files with 27 additions and 6 deletions

View File

@ -44,13 +44,16 @@ import Text.Julius
import Yesod.Form
import Yesod.Json
import Yesod.Persist
import Network.HTTP.Types (status200)
import Network.Wai (Application)
import Network.Wai.Middleware.RequestLogger
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Class (liftIO, MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl)
import Network.Wai
import Network.Wai.Logger
import Network.Wai.Handler.Warp (run)
import System.IO (stderr, hPutStrLn)
import System.IO (stderr, stdout, hFlush, hPutStrLn)
import System.Log.FastLogger
import Text.Blaze (toHtml)
showIntegral :: Integral a => a -> String
@ -70,9 +73,26 @@ warp port a = toWaiApp a >>= run port
-- | Same as 'warp', but also sends a message to stdout for each request, and
-- an \"application launched\" message as well. Can be useful for development.
warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
warpDebug port a = do
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
toWaiApp a >>= run port . logStdout
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 a development server, where your code changes are automatically
-- reloaded.

View File

@ -80,6 +80,7 @@ library
, transformers >= 0.2.2 && < 0.3
, wai >= 1.0 && < 1.1
, wai-extra >= 1.0 && < 1.1
, wai-logger >= 0.1.2
, hamlet >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11