    {-# 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