module Network.HTTP.Server.Logger
( Logger(..)
, stdLogger, quietLogger, utf8Logger
, LogItem(..), LogType(..)
, showLogItem, readLogItem, filterLog
) where
import System.IO (Handle,stdout,stderr,hFlush,hPutStrLn)
data Logger
= Logger
{ logInfo :: Int -> String -> IO ()
, logDebug :: String -> IO ()
, logError :: String -> IO ()
, logWarning :: String -> IO ()
, getLog :: Maybe Int
-> (LogType -> Bool)
-> IO [LogItem]
}
notSaved :: Maybe Int -> (LogType -> Bool) -> IO [LogItem]
notSaved l p = return $ filterLog l p
[LogItem Warning "Not saving the log"]
stdLogger :: Logger
stdLogger = utf8Logger stdout stderr
quietLogger :: Logger
quietLogger =
Logger
{ logInfo = \ _ _ -> return ()
, logDebug = \_ -> return ()
, logError = \_ -> return ()
, logWarning = \_ -> return ()
, getLog = notSaved
}
utf8Logger :: Handle -> Handle -> Logger
utf8Logger h hErr =
Logger
{ logInfo = \ _lev s -> logUTF8 h (LogItem (Info _lev) s)
, logDebug = logUTF8 h . LogItem Debug
, logError = logUTF8 hErr . LogItem Error
, logWarning = logUTF8 hErr . LogItem Warning
, getLog = notSaved
}
logUTF8 :: Handle -> LogItem -> IO ()
logUTF8 h i = hPutStrLn h (showLogItem i) >> hFlush h
data LogType = Error | Warning | Debug | Info Int deriving Show
data LogItem = LogItem { item_type :: LogType, item_data :: String }
showLogItem :: LogItem -> String
showLogItem (LogItem t txt) = show t ++ ": " ++ txt
readLogItem :: String -> Maybe LogItem
readLogItem l =
case break (':' ==) l of
("Error",_:txt) -> Just $ LogItem Error txt
("Warning",_:txt) -> Just $ LogItem Warning txt
("Debug",_:txt) -> Just $ LogItem Debug txt
('I':'n':'f':'o':' ':lvl,_:txt) ->
case reads lvl of
[(n,"")] -> Just $ LogItem (Info n) txt
_ -> Nothing
_ -> Nothing
filterLog :: Maybe Int -> (LogType -> Bool) -> [LogItem] -> [LogItem]
filterLog limit choose ls = case limit of
Just n -> take n allItems
_ -> allItems
where allItems = filter (choose . item_type) ls