@@ -0,0 +1,49 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Middleware.RequestLogger
3+ ( logStdout
4+ , logHandle
5+ , logStdoutDev
6+ , logHandleDevLT
7+ ) where
8+
9+import Network.Wai.Middleware.Debug (debug, debugHandle)
10+
11+import System.IO (stdout)
12+import qualified Data.ByteString as BS
13+import Control.Monad.IO.Class (liftIO)
14+import Network.Wai (Request(..), Middleware)
15+import System.Log.FastLogger
16+import Network.HTTP.Types as H
17+import qualified Data.Text.Lazy as LT
18+
19+-- | Inefficient, but convenient Development load logger middleware
20+logStdoutDev :: Middleware
21+logStdoutDev = debug
22+
23+-- | Inefficient, but convenient Development load logger middleware
24+logHandleDevLT :: (LT.Text -> IO ()) -> Middleware
25+logHandleDevLT = debugHandle
26+
27+-- | lik @logHandle@, but prints to 'stdout'
28+logStdout :: Middleware
29+logStdout = logHandle $ \bs -> hPutLogStr stdout [LB bs]
30+
31+-- | Prints a message using the given callback function for each request.
32+-- Designed for fast production use at the expense of convenience.
33+-- In particular, no POST parameter information is currently given
34+-- For something with more useful output, use Network.Wai.Middleware.Debug
35+logHandle :: (BS.ByteString -> IO ()) -> Middleware
36+logHandle cb app req = do
37+ liftIO $ cb $ BS.concat
38+ [ requestMethod req
39+ , " "
40+ , rawPathInfo req
41+ , rawQueryString req
42+ , " "
43+ , "Accept: "
44+ , maybe "" toBS $ lookup "Accept" $ requestHeaders req
45+ ]
46+ app req
47+
48+toBS :: H.Ascii -> BS.ByteString
49+toBS = id