salvia-0.1: src/Network/Salvia/Handler/Log.hs

module Network.Salvia.Handler.Log (
    hLog
  , hLogWithCounter
  ) where

import Control.Concurrent.STM
import Control.Monad.State
import Data.Record.Label
import Misc.Terminal (red, green, reset)
import Network.Protocol.Http
import Network.Salvia.Httpd  (Handler, request, response, address)
import System.IO

{- |
A simple logger that prints a summery of the request information to the
specified file handle.
-}

hLog :: Handle -> Handler ()
hLog = logger Nothing

{- | Like `hLog` but also prints the request count since server startup. -}

hLogWithCounter :: TVar Int -> Handle -> Handler ()
hLogWithCounter a = logger (Just a)

logger :: Maybe (TVar Int) -> Handle -> Handler ()
logger count handle = do
  c <- case count of
    Nothing -> return ""
    Just c' -> liftIO (show `liftM` atomically (readTVar c'))
  mt   <- getM (method % request)
  ur   <- getM (uri    % request)
  st   <- getM (status % response)
  addr <- getM address
  let code = codeFromStatus st
      clr  = if code >= 400 then red else green
  liftIO $ hPutStrLn handle $ concat [
      concat ["[", show addr, "] ", c, "\t"]
    , show mt, "\t"
    , show ur, " -> "
    , clr
    , show code, " "
    , show st
    , reset
    ]