on master help sign in
add logStdoutDev and logHandleDev

These use ByteString instead of Lazy Text

commit0e7edb5fb1c5bb3767dbd8f9594eaed941b75015 authorGreg Weber <greg@gregweber.info> dateSun 25 Dec 2011, 23:34 (15 years ago) parent0ffd738
1 file changed+26−11
wai-extra/Network/Wai/Middleware/RequestLogger.hs+26−11
wai-extra/Network/Wai/Middleware/RequestLogger.hs+26−11
@@ -2,29 +2,36 @@
22module Network.Wai.Middleware.RequestLogger
33 ( logStdout
44 , logHandle
5+ , logStdoutDev
6+ , logHandleDev
57 , logStdoutDevLT
68 , logHandleDevLT
79 ) where
810
911import System.IO (stdout)
1012import qualified Data.ByteString as BS
13+import Data.ByteString.Char8 (pack)
1114import Control.Monad.IO.Class (liftIO)
1215import Network.Wai (Request(..), Middleware)
1316import System.Log.FastLogger
1417import Network.HTTP.Types as H
1518import qualified Data.Text.Lazy as LT
19+import qualified Data.Text.Encoding as TE
1620
1721import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File)
1822import qualified Data.ByteString.Lazy as LBS
1923import Data.Enumerator (run_, ($$), enumList)
2024import Data.Enumerator.List (consume)
2125import System.IO (hPutStrLn, stderr)
22−import Data.ByteString.Char8 (unpack)
2326
24−-- | lik @logHandle@, but prints to 'stdout'
27+-- | like @logHandle@, but prints to 'stdout'
2528logStdout :: Middleware
2629logStdout = logHandle $ \bs -> hPutLogStr stdout [LB bs]
2730
31+-- | like @logHandleDev@, but prints to 'stdout'
32+logStdoutDev :: Middleware
33+logStdoutDev = logHandleDev $ \bs -> hPutLogStr stdout [LB bs]
34+
2835-- | Prints a message using the given callback function for each request.
2936-- Designed for fast production use at the expense of convenience.
3037-- In particular, no POST parameter information is currently given
@@ -50,12 +57,17 @@ toBS = id
5057logStdoutDevLT :: Middleware
5158logStdoutDevLT = logHandleDevLT $ hPutStrLn stderr . LT.unpack
5259
60+-- | logHandleDev, but expects Lazy Text instead of a ByteString
61+logHandleDevLT :: (LT.Text -> IO ()) -> Middleware
62+logHandleDevLT cb app req =
63+ logHandleDev (\msg -> cb $ LT.fromStrict $ TE.decodeUtf8 msg) app req
64+
5365-- | Prints a message using the given callback function for each request.
5466-- This is not for serious production use- it is inefficient.
5567-- It immediately consumes a POST body and fills it back in and is otherwise inefficient
5668-- For production use use module Network.Wai.Middleware.RequestLogger
57−logHandleDevLT :: (LT.Text -> IO ()) -> Middleware
58−logHandleDevLT cb app req = do
69+logHandleDev :: (BS.ByteString -> IO ()) -> Middleware
70+logHandleDev cb app req = do
5971 body <- consume
6072 postParams <- if any (requestMethod req ==) ["GET", "HEAD"]
6173 then return []
@@ -63,19 +75,22 @@ logHandleDevLT cb app req = do
6375 return $ collectPostParams postParams
6476 let getParams = map emptyGetParam $ queryString req
6577
66− liftIO $ cb $ LT.pack $ concat
67− [ unpack $ requestMethod req
78+ liftIO $ cb $ BS.concat
79+ [ requestMethod req
6880 , " "
69− , unpack $ rawPathInfo req
81+ , rawPathInfo req
7082 , "\n"
71− , (++) "Accept: " $ maybe "" unpack $ lookup "Accept" $ requestHeaders req
72− , paramsToStr "GET " getParams
73− , paramsToStr "POST " postParams
83+ , "Accept: "
84+ , maybe "" id $ lookup "Accept" $ requestHeaders req
85+ , paramsToBS "GET " getParams
86+ , paramsToBS "POST " postParams
7487 ]
7588 -- we just consumed the body- fill the enumerator back up so it is available again
7689 liftIO $ run_ $ enumList 1 body $$ app req
7790 where
78− paramsToStr prefix params = if null params then "" else "\n" ++ prefix ++ (show params)
91+ paramsToBS prefix params =
92+ if null params then ""
93+ else BS.concat ["\n", prefix, pack (show params)]
7994
8095 allPostParams req' body = run_ $ enumList 1 body $$ parseRequestBody lbsSink req'
8196