git.iko.soy/typeable/wai
on master help sign in
Merge pull request #215 from yesodweb/small-accept-log

devel logger: Accept doesn't need its own line

commit929264ea87a63bed3eee79b69b1180a389042422 authorMichael Snoyman <michael@snoyman.com> dateMon 6 Jan 2014, 21:52 (13 years ago) parent808ee2a58a36b6
2 files changed+22−17
compare with master
unifiedsplit
wai-extra/Network/Wai/Middleware/RequestLogger.hs+20−15 wai-extra/test/WaiExtraTest.hs+2−2
wai-extra/Network/Wai/Middleware/RequestLogger.hs+20−15
@@ -177,12 +177,13 @@ detailedMiddleware cb useColors = do
177177 return $ ansiColor color
178178 else return (return return)
179179 return $ detailedMiddleware' cb getAddColor
180− where
181− ansiColor color bs = [
182− pack $ setSGRCode [SetColor Foreground Vivid color]
183− , bs
184− , pack $ setSGRCode [Reset]
185− ]
180+
181+ansiColor :: Color -> BS.ByteString -> [BS.ByteString]
182+ansiColor color bs = [
183+ pack $ setSGRCode [SetColor Foreground Vivid color]
184+ , bs
185+ , pack $ setSGRCode [Reset]
186+ ]
186187
187188detailedMiddleware' :: Callback
188189 -> IO (BS.ByteString -> [BS.ByteString])
@@ -225,14 +226,14 @@ detailedMiddleware' cb getAddColor app req = do
225226 let getParams = map emptyGetParam $ queryString req
226227
227228 addColor <- getAddColor
229+ let accept = fromMaybe "" $ lookup "Accept" $ requestHeaders req
228230
229231 -- log the request immediately.
230232 liftIO $ cb $ mconcat $ map toLogStr $ addColor (requestMethod req) ++
231233 [ " "
232234 , rawPathInfo req
233− , "\n"
234− , "Accept: "
235− , fromMaybe "" $ lookup "Accept" $ requestHeaders req
235+ , " | "
236+ , accept
236237 , paramsToBS "GET " getParams
237238 , paramsToBS "POST " postParams
238239 , "\n"
@@ -243,14 +244,14 @@ detailedMiddleware' cb getAddColor app req = do
243244 -- log the status of the response
244245 -- this is color coordinated with the request logging
245246 -- also includes the request path to connect it to the request
246− liftIO $ cb $ mconcat $ map toLogStr $ addColor "Status: " ++ [
247− statusBS rsp
248− , " "
247+ liftIO $ cb $ mconcat $ map toLogStr $
248+ addColor "Status: " ++ statusBS rsp ++
249+ [ " "
249250 , msgBS rsp
250251 , ". "
251252 , rawPathInfo req -- if you need help matching the 2 logging statements
252253 , "\n"
253− ]
254+ ]
254255 return rsp
255256 where
256257 paramsToBS prefix params =
@@ -275,8 +276,12 @@ detailedMiddleware' cb getAddColor app req = do
275276 (i, _):_ -> Just (i :: Int)
276277 [] -> Nothing
277278
278−statusBS :: Response -> BS.ByteString
279−statusBS = pack . show . statusCode . responseStatus
279+statusBS :: Response -> [BS.ByteString]
280+statusBS rsp =
281+ if status > 400 then ansiColor Red bs else [bs]
282+ where
283+ bs = pack $ show status
284+ status = statusCode $ responseStatus rsp
280285
281286msgBS :: Response -> BS.ByteString
282287msgBS = statusMessage . responseStatus
wai-extra/test/WaiExtraTest.hs+2−2
@@ -546,8 +546,8 @@ caseDebugRequestBody = do
546546 where
547547 params = [("foo", "bar"), ("baz", "bin")]
548548 -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
549− postOutput = T.pack $ "POST /\nAccept: \nStatus: 200 OK. /\n"
550− getOutput params' = T.pack $ "GET /location\nAccept: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
549+ postOutput = T.pack $ "POST / | \nStatus: 200 OK. /\n"
550+ getOutput params' = T.pack $ "GET /location | \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
551551
552552 debugApp output' req = do
553553 iactual <- liftIO $ I.newIORef mempty