{-# LANGUAGE CPP #-}
{- |
   Module     : System.Log.Handler.Log4jXML
   Copyright  : Copyright (C) 2007-2011 John Goerzen
   License    : BSD3

   Portability: GHC only?

log4j[1] XMLLayout log handlers.

Written by Bjorn Buckwalter, bjorn.buckwalter\@gmail.com
-}


module System.Log.Handler.Log4jXML (

    -- * Introduction

    {- | This module provides handlers for hslogger that are
    compatible with log4j's XMLLayout. In particular log messages
    created by the handlers can be published directly to the GUI-based
    log viewer Chainsaw v2[2].

    The set of log levels in hslogger is richer than the basic set
    of log4j levels. Two sets of handlers are provided with hslogger4j,
    one which produces logs with hslogger's levels and one which
    \"demotes\" them to the basic log4j levels. If full hslogger
    levels are used some Java installation (see below) is necessary
    to make Chainsaw aware of them.

    Usage of the handlers in hslogger4j is analoguous to usage of
    the 'System.Log.Handler.Simple.StreamHandler' and
    'System.Log.Handler.Simple.FileHandler' in "System.Log.Handler.Simple".
    The following handlers are provided: -}

    -- ** Handlers with hslogger levels
    log4jStreamHandler,
    log4jFileHandler,

    -- ** Handlers with log4j levels
    log4jStreamHandler',
    log4jFileHandler'


    -- * Java install process

    {- | This is only necessary if you want to use the hslogger levels.

    Add @hslogger4j.jar@ from @contrib\/java@ to your classpath.
    To use you will also need to have the jars @log4j-1.3alpha-7.jar@
    and @log4j-xml-1.3alpha-7.jar@ that are distributed with Chainsaw
    on your classpath.

    (On Mac OS X I added all three jars to @~\/Library\/Java\/Extensions@.
    It seems that it is not sufficient that Chainsaw already includes
    its jars in the classpath when launching - perhaps the plugin
    classloader does not inherit Chainsaw's classpath. Adding the
    jars to @~\/.chainsaw\/plugins@ wouldn't work either.)

    If for whatever reason you have to rebuild the hslogger4j jar
    just run @ant@[3] in the @contrib\/java@ directory. The new jar
    will be created in the @contrib\/java\/dist@ directory. The Java
    source code is copyright The Apache Software Foundation and
    licensed under the Apache Licence version 2.0. -}


    -- * Chainsaw setup

    {- | If you are only using the basic log4j levels just use
    Chainsaw's regular facilities to browse logs or listen for log
    messages (e.g. @XMLSocketReceiver@).

    If you want to use the hslogger levels the easiest way to set
    up Chainsaw is to load the plugins in @hslogger4j-plugins.xml@
    in @contrib\/java@ when launching Chainsaw. Two receivers will
    be defined, one that listens for logmessages and one for reading
    log files.  Edit the properties of those receivers as needed
    (e.g. @port@, @fileURL@) and restart them. You will also want
    to modify Chainsaw's formatting preferences to display levels
    as text instead of icons. -}


    -- * Example usage

    {- | In the IO monad:

    > lh2 <- log4jFileHandler "log.xml" DEBUG
    > updateGlobalLogger rootLoggerName (addHandler lh2)

    > h  <- connectTo "localhost" (PortNumber 4448)
    > lh <- log4jStreamHandler h NOTICE
    > updateGlobalLogger rootLoggerName (addHandler lh)
    -}

    -- * References

    {- |
    (1) <http://logging.apache.org/log4j/>

    (2) <http://logging.apache.org/chainsaw/>

    (3) <http://ant.apache.org/>
    -}

    ) where

import Control.Concurrent (myThreadId)  -- myThreadId is GHC only!
import Data.List (isPrefixOf)
import System.IO
import Data.Time.Format (defaultTimeLocale)
import Data.Time
import System.Log
import System.Log.Handler
import System.Log.Handler.Simple (streamHandler, GenericHandler(..))


-- Handler that logs to a handle rendering message priorities according
-- to the supplied function.
log4jHandler :: (Priority -> String) -> Handle -> Priority -> IO (GenericHandler Handle)
log4jHandler :: (Priority -> String)
-> Handle -> Priority -> IO (GenericHandler Handle)
log4jHandler Priority -> String
showPrio Handle
h Priority
pri = do
    hndlr <- Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
h Priority
pri
    return $ setFormatter hndlr xmlFormatter

   where
        -- A Log Formatter that creates an XML element representing a log4j event/message.
        xmlFormatter :: a -> (Priority,String) -> String -> IO String
        xmlFormatter :: forall a. a -> (Priority, String) -> String -> IO String
xmlFormatter a
_ (Priority
prio,String
msg) String
logger = do
              time <- IO UTCTime
getCurrentTime
              thread <- myThreadId
              return . show $ Elem "log4j:event"
                         [ ("logger"   , logger       )
                         , ("timestamp", millis time  )
                         , ("level"    , showPrio prio)
                         , ("thread"   , show thread  )
                         ]
                         (Just $ Elem "log4j:message" [] (Just $ CDATA msg))
            where
                -- This is an ugly hack to get a unix epoch with milliseconds.
                -- The use of "take 3" causes the milliseconds to always be
                -- rounded downwards, which I suppose may be the expected
                -- behaviour for time.
                millis :: t -> String
millis t
t = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s" t
t
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%q" t
t)


-- | Create a stream log handler that uses hslogger priorities.
log4jStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
log4jStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle)
log4jStreamHandler = (Priority -> String)
-> Handle -> Priority -> IO (GenericHandler Handle)
log4jHandler Priority -> String
forall a. Show a => a -> String
show

{- | Create a stream log handler that uses log4j levels (priorities). The
   priorities of messages are shoehorned into log4j levels as follows:

@
    DEBUG                  -> DEBUG
    INFO, NOTICE           -> INFO
    WARNING                -> WARN
    ERROR, CRITICAL, ALERT -> ERROR
    EMERGENCY              -> FATAL
@

   This is useful when the log will only be consumed by log4j tools and
   you don't want to go out of your way transforming the log or configuring
   the tools. -}
log4jStreamHandler' :: Handle -> Priority -> IO (GenericHandler Handle)
log4jStreamHandler' :: Handle -> Priority -> IO (GenericHandler Handle)
log4jStreamHandler' = (Priority -> String)
-> Handle -> Priority -> IO (GenericHandler Handle)
log4jHandler Priority -> String
show' where
    show' :: Priority -> String
    show' :: Priority -> String
show' Priority
NOTICE    = String
"INFO"
    show' Priority
WARNING   = String
"WARN"
    show' Priority
CRITICAL  = String
"ERROR"
    show' Priority
ALERT     = String
"ERROR"
    show' Priority
EMERGENCY = String
"FATAL"
    show' Priority
p         = Priority -> String
forall a. Show a => a -> String
show Priority
p  -- Identical for DEBUG, INFO, ERROR.


-- | Create a file log handler that uses hslogger priorities.
log4jFileHandler :: FilePath -> Priority -> IO (GenericHandler Handle)
log4jFileHandler :: String -> Priority -> IO (GenericHandler Handle)
log4jFileHandler String
fp Priority
pri = do
                          h <- String -> IOMode -> IO Handle
openFile String
fp IOMode
AppendMode
                          sh <- log4jStreamHandler h pri
                          return (sh{closeFunc = hClose})

{- | Create a file log handler that uses log4j levels (see
   'log4jStreamHandler'' for mappings). -}
log4jFileHandler' :: FilePath -> Priority -> IO (GenericHandler Handle)
log4jFileHandler' :: String -> Priority -> IO (GenericHandler Handle)
log4jFileHandler' String
fp Priority
pri = do
                           h <- String -> IOMode -> IO Handle
openFile String
fp IOMode
AppendMode
                           sh <- log4jStreamHandler' h pri
                           return (sh{closeFunc = hClose})


-- A type for building and showing XML elements. Could use a fancy XML
-- library but am reluctant to introduce dependencies.
data XML = Elem  String [(String, String)] (Maybe XML)
         | CDATA String

instance Show XML where
    show :: XML -> String
show (CDATA String
s) = String
"<![CDATA[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeCDATA String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]]>" where
        escapeCDATA :: String -> String
escapeCDATA = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"]]>" String
"]]&lt;"  -- The best we can do, I guess.
    show (Elem String
name [(String, String)]
attrs Maybe XML
child) = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
showAttrs [(String, String)]
attrs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe XML -> String
forall {a}. Show a => Maybe a -> String
showChild Maybe XML
child where
        showAttrs :: [(String, String)] -> String
showAttrs []         = String
""
        showAttrs ((String
k,String
v):[(String, String)]
as) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escapeAttr String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
showAttrs [(String, String)]
as
            where escapeAttr :: String -> String
escapeAttr = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"\"" String
"&quot;"
                             (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"<" String
"&lt;"
                             (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"&" String
"&amp;"
        showChild :: Maybe a -> String
showChild Maybe a
Nothing  = String
"/>"
        showChild (Just a
c) = String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"


-- Replaces instances of first list by second list in third list.
-- Definition blatantly stoled from jethr0's comment at
-- http://bluebones.net/2007/01/replace-in-haskell/. Can be swapped
-- with definition (or import) from MissingH.
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
_    [a]
_  [       ] = []
replace [a]
from [a]
to xs :: [a]
xs@(a
a:[a]
as) = if [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
from [a]
xs
    then [a]
to [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
from) [a]
xs else a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
from [a]
to [a]
as