    {-# LANGUAGE CPP, ExistentialQuantification #-}

    {- |
       Module     : System.Log.Logger
       Copyright  : Copyright (C) 2004-2011 John Goerzen
       License    : BSD3

       Portability: portable

    Haskell Logging Framework, Primary Interface

    Written by John Goerzen, jgoerzen\@complete.org

    Welcome to the error and information logging system for Haskell.

    This system is patterned after Python\'s @logging@ module,
    <http://www.python.org/doc/current/lib/module-logging.html> and some of
    the documentation here was based on documentation there.

    To log a message, you perform operations on 'Logger's.  Each 'Logger' has a
    name, and they are arranged hierarchically.  Periods serve as separators.
    Therefore, a 'Logger' named \"foo\" is the parent of loggers \"foo.printing\",
    \"foo.html\", and \"foo.io\".  These names can be anything you want.  They're
    used to indicate the area of an application or library in which a logged
    message originates.  Later you will see how you can use this concept to
    fine-tune logging behaviors based on specific application areas.

    You can also tune logging behaviors based upon how important a message is.
    Each message you log will have an importance associated with it.  The different
    importance levels are given by the 'Priority' type.  I've also provided
    some convenient functions that correspond to these importance levels:
    'debugM' through 'emergencyM' log messages with the specified importance.

    Now, an importance level (or 'Priority')
    is associated not just with a particular message but also
    with a 'Logger'.  If the 'Priority' of a given log message is lower than
    the 'Priority' configured in the 'Logger', that message is ignored.  This
    way, you can globally control how verbose your logging output is.

    Now, let's follow what happens under the hood when you log a message.  We'll
    assume for the moment that you are logging something with a high enough
    'Priority' that it passes the test in your 'Logger'.  In your code, you'll
    call 'logM' or something like 'debugM' to log the message.  Your 'Logger'
    decides to accept the message.  What next?

    Well, we also have a notion of /handlers/ ('LogHandler's, to be precise).
    A 'LogHandler' is a thing that takes a message and sends it somewhere.
    That \"somewhere\" may be your screen (via standard error), your system's
    logging infrastructure (via syslog), a file, or other things.  Each
    'Logger' can have zero or more 'LogHandler's associated with it.  When your
    'Logger' has a message to log, it passes it to every 'LogHandler' it knows
    of to process.  What's more, it is also passed to /all handlers of all
    ancestors of the Logger/, regardless of whether those 'Logger's would
    normally have passed on the message.

    Each 'Logger' can /optionally/ store a 'Priority'.  If a given Logger does
    not have a Priority, and you log a message to that logger, the system will
    use the priority of the parent of the destination logger to find out whether
    to log the message.  If the parent has no priority associated with it,
    the system continues walking up the tree to figure out a priority until
    it hits the root logger.  In this way, you can easily adjust the priority
    of an entire subtree of loggers.  When a new logger is created, it has no
    priority by default.  The exception is the root logger, which has a WARNING
    priority by default.

    To give you one extra little knob to turn, 'LogHandler's can also have
    importance levels ('Priority') associated with them in the same way
    that 'Logger's do.  They act just like the 'Priority' value in the
    'Logger's -- as a filter.  It's useful, for instance, to make sure that
    under no circumstances will a mere 'DEBUG' message show up in your syslog.

    There are three built-in handlers given in two built-in modules:
    "System.Log.Handler.Simple" and "System.Log.Handler.Syslog".

    There is a special logger known as the /root logger/ that sits at the top
    of the logger hierarchy.  It is always present, and handlers attached
    there will be called for every message.  You can use 'getRootLogger' to get
    it or 'rootLoggerName' to work with it by name.

    The formatting of log messages may be customized by setting a 'LogFormatter'
    on the desired 'LogHandler'.  There are a number of simple formatters defined
    in "System.Log.Formatter", which may be used directly, or extend to create
    your own formatter.

    Here's an example to illustrate some of these concepts:

    > import System.Log.Logger
    > import System.Log.Handler.Syslog
    > import System.Log.Handler.Simple
    > import System.Log.Handler (setFormatter)
    > import System.Log.Formatter
    >
    > -- By default, all messages of level WARNING and above are sent to stderr.
    > -- Everything else is ignored.
    >
    > -- "MyApp.Component" is an arbitrary string; you can tune
    > -- logging behavior based on it later.
    > main = do
    >        logger1 <- getLogger "MyApp.Component"
    >        logger2 <- getLogger "MyApp.Component2"
    >        loggerB <- getLogger "MyApp.BuggyComponent"
    >        loggerW <- getLogger "MyApp.WorkingComponent"
    >
    >        logL logger1 DEBUG "This is a debug message -- never to be seen"
    >        logL logger2 WARNING "Something Bad is about to happen."
    >
    >        -- Copy everything to syslog from here on out.
    >        s <- openlog "SyslogStuff" [PID] USER DEBUG
    >        saveGlobalLogger =<< addHandler s <$> getRootLogger
    >
    >        logL logger1 ERROR "This is going to stderr and syslog."
    >
    >        -- Now we'd like to see everything from BuggyComponent
    >        -- at DEBUG or higher go to syslog and stderr.
    >        -- Also, we'd like to still ignore things less than
    >        -- WARNING in other areas.
    >        --
    >        -- So, we adjust the Logger for MyApp.BuggyComponent.
    >
    >        let loggerB' = setLevel DEBUG loggerB
    >        saveGlobalLogger loggerB'
    >
    >        -- This message will go to syslog and stderr
    >        logL loggerB' DEBUG "This buggy component is buggy"
    >
    >        -- This message will go to syslog and stderr too.
    >        logL loggerB' WARNING "Still Buggy"
    >
    >        -- This message goes nowhere.
    >        logL loggerW DEBUG "Hello"
    >
    >        -- Now we decide we'd also like to log everything from BuggyComponent at DEBUG
    >        -- or higher to a file for later diagnostics.  We'd also like to customize the
    >        -- format of the log message, so we use a 'simpleLogFormatter'
    >
    >        h <- fileHandler "debug.log" DEBUG >>= \lh -> return $
    >                 setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")
    >        let loggerB'' = addHandler h loggerB'
    >        saveGlobalLogger loggerB''
    >
    >        -- This message will go to syslog and stderr,
    >        -- and to the file "debug.log" with a format like :
    >        -- [2010-05-23 16:47:28 : MyApp.BuggyComponent : DEBUG] Some useful diagnostics...
    >        logL loggerB'' DEBUG "Some useful diagnostics..."
    >
    >
    -}

    module System.Log.Logger(
                                   -- * Basic Types
                                   Logger,
                                   -- ** Re-Exported from System.Log
                                   Priority(..),
                                   -- * Logging Messages
                                   -- ** Basic
                                   logM,
                                   -- ** Utility Functions
                                   -- These functions are wrappers for 'logM' to
                                   -- make your job easier.
                                   debugM, infoM, noticeM, warningM, errorM,
                                   criticalM, alertM, emergencyM,
                                   removeAllHandlers,
                                   traplogging,
                                   -- ** Logging to a particular Logger by object
                                   logL,
                                   -- * Logger Manipulation
    {- | These functions help you work with loggers.  There are some
    special things to be aware of.

    First of all, whenever you first access a given logger by name, it
    magically springs to life.  It has a default 'Priority' of Nothing
    and an empty handler list -- which means that it will inherit whatever its
    parents do.
    -}
                                   -- ** Finding \/ Creating Loggers
                                   getLogger, getRootLogger, rootLoggerName,
                                   -- ** Modifying Loggers
    {- | Keep in mind that \"modification\" here is modification in the Haskell
    sense.  We do not actually cause mutation in a specific 'Logger'.  Rather,
    we return you a new 'Logger' object with the change applied.

    Also, please note that these functions will not have an effect on the
    global 'Logger' hierarchy.  You may use your new 'Logger's locally,
    but other functions won't see the changes.  To make a change global,
    you'll need to use 'updateGlobalLogger' or 'saveGlobalLogger'.
    -}
                                   addHandler, removeHandler, setHandlers,
                                   getLevel, setLevel, clearLevel,
                                   -- ** Saving Your Changes
    {- | These functions commit changes you've made to loggers to the global
    logger hierarchy. -}
                                   saveGlobalLogger,
                                   updateGlobalLogger
                                   ) where
    import System.Log
    import System.Log.Handler(LogHandler, close)
    import System.Log.Formatter(LogFormatter) -- for Haddock
    import qualified System.Log.Handler(handle)
    import System.Log.Handler.Simple
    import System.IO
    import System.IO.Unsafe
    import Control.Concurrent.MVar
    import Data.List(map, isPrefixOf)
    import Data.Maybe
    import qualified Data.Map as Map
    import qualified Control.Exception

    ---------------------------------------------------------------------------
    -- Basic logger types
    ---------------------------------------------------------------------------
    data HandlerT = forall a. LogHandler a => HandlerT a

    data Logger = Logger { Logger -> Maybe Priority
    level :: Maybe Priority,
                           Logger -> [HandlerT]
    handlers :: [HandlerT],
                           Logger -> String
    name :: String}

    type LogTree = Map.Map String Logger

    {- | This is the base class for the various log handlers.  They should
    all adhere to this class. -}

    ---------------------------------------------------------------------------
    -- Utilities
    ---------------------------------------------------------------------------

    -- | The name of the root logger, which is always defined and present
    -- on the system.
    rootLoggerName :: String
    rootLoggerName :: String
    rootLoggerName = String
    ""

    ---------------------------------------------------------------------------
    -- Logger Tree Storage
    ---------------------------------------------------------------------------

    -- | The log tree.  Initialize it with a default root logger
    -- and (FIXME) a logger for MissingH itself.

    {-# NOINLINE logTree #-}

    logTree :: MVar LogTree
    -- note: only kick up tree if handled locally
    logTree :: MVar LogTree
    logTree =
        IO (MVar LogTree) -> MVar LogTree
    forall a. IO a -> a
    unsafePerformIO (IO (MVar LogTree) -> MVar LogTree)
    -> IO (MVar LogTree) -> MVar LogTree
    forall a b. (a -> b) -> a -> b
    $ do
                          h <- Handle -> Priority -> IO (GenericHandler Handle)
    streamHandler Handle
    stderr Priority
    DEBUG
                          newMVar (Map.singleton rootLoggerName (Logger
                                                       {level = Just WARNING,
                                                        name = "",
                                                        handlers = [HandlerT h]}))

    {- | Given a name, return all components of it, starting from the root.
    Example return value:

    >["", "MissingH", "System.Cmd.Utils", "System.Cmd.Utils.pOpen"]

    -}
    componentsOfName :: String -> [String]
    componentsOfName :: String -> [String]
    componentsOfName String
    name' =
        let joinComp :: [String] -> String -> [String]
    joinComp [] String
    _ = []
            joinComp (String
    x:[String]
    xs) [] = String
    x String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String] -> String -> [String]
    joinComp [String]
    xs String
    x
            joinComp (String
    x:[String]
    xs) String
    accum =
                let newlevel :: String
    newlevel = String
    accum String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x in
                    String
    newlevel String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String] -> String -> [String]
    joinComp [String]
    xs String
    newlevel
            in
            String
    rootLoggerName String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String] -> String -> [String]
    joinComp (String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    split String
    "." String
    name') []

    ---------------------------------------------------------------------------
    -- Logging With Location
    ---------------------------------------------------------------------------

    {- | Log a message using the given logger at a given priority. -}

    logM :: String                           -- ^ Name of the logger to use
         -> Priority                         -- ^ Priority of this message
         -> String                           -- ^ The log text itself
         -> IO ()

    logM :: String -> Priority -> String -> IO ()
    logM String
    logname Priority
    pri String
    msg = do
                           l <- String -> IO Logger
    getLogger String
    logname
                           logL l pri msg

    ---------------------------------------------------------------------------
    -- Utility functions
    ---------------------------------------------------------------------------

    {- | Log a message at 'DEBUG' priority -}
    debugM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    debugM :: String -> String -> IO ()
    debugM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    DEBUG

    {- | Log a message at 'INFO' priority -}
    infoM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    infoM :: String -> String -> IO ()
    infoM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    INFO

    {- | Log a message at 'NOTICE' priority -}
    noticeM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    noticeM :: String -> String -> IO ()
    noticeM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    NOTICE

    {- | Log a message at 'WARNING' priority -}
    warningM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    warningM :: String -> String -> IO ()
    warningM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    WARNING

    {- | Log a message at 'ERROR' priority -}
    errorM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    errorM :: String -> String -> IO ()
    errorM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    ERROR

    {- | Log a message at 'CRITICAL' priority -}
    criticalM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    criticalM :: String -> String -> IO ()
    criticalM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    CRITICAL

    {- | Log a message at 'ALERT' priority -}
    alertM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    alertM :: String -> String -> IO ()
    alertM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    ALERT

    {- | Log a message at 'EMERGENCY' priority -}
    emergencyM :: String                         -- ^ Logger name
          -> String                         -- ^ Log message
          -> IO ()
    emergencyM :: String -> String -> IO ()
    emergencyM String
    s = String -> Priority -> String -> IO ()
    logM String
    s Priority
    EMERGENCY

    ---------------------------------------------------------------------------
    -- Public Logger Interaction Support
    ---------------------------------------------------------------------------

    -- | Returns the logger for the given name.  If no logger with that name
    -- exists, creates new loggers and any necessary parent loggers, with
    -- no connected handlers.

    getLogger :: String -> IO Logger
    getLogger :: String -> IO Logger
    getLogger String
    lname = MVar LogTree -> (LogTree -> IO (LogTree, Logger)) -> IO Logger
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar LogTree
    logTree ((LogTree -> IO (LogTree, Logger)) -> IO Logger)
    -> (LogTree -> IO (LogTree, Logger)) -> IO Logger
    forall a b. (a -> b) -> a -> b
    $ \LogTree
    lt ->
        case String -> LogTree -> Maybe Logger
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    lname LogTree
    lt of
             Just Logger
    x ->  (LogTree, Logger) -> IO (LogTree, Logger)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LogTree
    lt, Logger
    x) -- A logger exists; return it and leave tree
             Maybe Logger
    Nothing -> do
                        -- Add logger(s).  Then call myself to retrieve it.
                        let newlt :: LogTree
    newlt = [String] -> LogTree -> LogTree
    createLoggers (String -> [String]
    componentsOfName String
    lname) LogTree
    lt
                        let result :: Logger
    result = Maybe Logger -> Logger
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Logger -> Logger) -> Maybe Logger -> Logger
    forall a b. (a -> b) -> a -> b
    $ String -> LogTree -> Maybe Logger
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    lname LogTree
    newlt
                        (LogTree, Logger) -> IO (LogTree, Logger)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LogTree
    newlt, Logger
    result)
        where createLoggers :: [String] -> LogTree -> LogTree
              createLoggers :: [String] -> LogTree -> LogTree
    createLoggers [] LogTree
    lt = LogTree
    lt -- No names to add; return tree unmodified
              createLoggers (String
    x:[String]
    xs) LogTree
    lt = -- Add logger to tree
                  if String -> LogTree -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member String
    x LogTree
    lt
                     then [String] -> LogTree -> LogTree
    createLoggers [String]
    xs LogTree
    lt
                     else [String] -> LogTree -> LogTree
    createLoggers [String]
    xs
                              (String -> Logger -> LogTree -> LogTree
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert String
    x (Logger
    defaultLogger {name=x}) LogTree
    lt)
              defaultLogger :: Logger
    defaultLogger = Maybe Priority -> [HandlerT] -> String -> Logger
    Logger Maybe Priority
    forall a. Maybe a
    Nothing [] String
    forall a. HasCallStack => a
    undefined

    -- | Returns the root logger.

    getRootLogger :: IO Logger
    getRootLogger :: IO Logger
    getRootLogger = String -> IO Logger
    getLogger String
    rootLoggerName

    -- | Log a message, assuming the current logger's level permits it.
    logL :: Logger -> Priority -> String -> IO ()
    logL :: Logger -> Priority -> String -> IO ()
    logL Logger
    l Priority
    pri String
    msg = Logger -> LogRecord -> IO ()
    handle Logger
    l (Priority
    pri, String
    msg)

    -- | Handle a log request.
    handle :: Logger -> LogRecord -> IO ()
    handle :: Logger -> LogRecord -> IO ()
    handle Logger
    l (Priority
    pri, String
    msg) =
        let parentLoggers :: String -> IO [Logger]
            parentLoggers :: String -> IO [Logger]
    parentLoggers [] = [Logger] -> IO [Logger]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            parentLoggers String
    name' =
                let pname :: String
    pname = ([String] -> String
    forall a. HasCallStack => [a] -> a
    head ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    componentsOfName) String
    name'
                    in
                    do parent <- String -> IO Logger
    getLogger String
    pname
                       next <- parentLoggers pname
                       return (parent : next)
            parentHandlers :: String -> IO [HandlerT]
            parentHandlers :: String -> IO [HandlerT]
    parentHandlers String
    name' = String -> IO [Logger]
    parentLoggers String
    name' IO [Logger] -> ([Logger] -> IO [HandlerT]) -> IO [HandlerT]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ([HandlerT] -> IO [HandlerT]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([HandlerT] -> IO [HandlerT])
    -> ([Logger] -> [HandlerT]) -> [Logger] -> IO [HandlerT]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Logger -> [HandlerT]) -> [Logger] -> [HandlerT]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Logger -> [HandlerT]
    handlers)

            -- Get the priority we should use.  Find the first logger in the tree,
            -- starting here, with a set priority.  If even root doesn't have one,
            -- assume DEBUG.
            getLoggerPriority :: String -> IO Priority
            getLoggerPriority :: String -> IO Priority
    getLoggerPriority String
    name' =
                do pl <- String -> IO [Logger]
    parentLoggers String
    name'
                   case catMaybes . map level $ (l : pl) of
                     [] -> Priority -> IO Priority
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Priority
    DEBUG
                     (Priority
    x:[Priority]
    _) -> Priority -> IO Priority
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Priority
    x
            in
            do lp <- String -> IO Priority
    getLoggerPriority (Logger -> String
    name Logger
    l)
               if pri >= lp
                  then do
                    ph <- parentHandlers (name l)
                    sequence_ (handlerActions (ph ++ (handlers l)) (pri, msg)
                                              (name l))
                  else return ()

    -- | Call a handler given a HandlerT.
    callHandler :: LogRecord -> String -> HandlerT -> IO ()
    callHandler :: LogRecord -> String -> HandlerT -> IO ()
    callHandler LogRecord
    lr String
    loggername HandlerT
    ht =
        case HandlerT
    ht of
                HandlerT a
    x -> a -> LogRecord -> String -> IO ()
    forall a. LogHandler a => a -> LogRecord -> String -> IO ()
    System.Log.Handler.handle a
    x LogRecord
    lr String
    loggername

    -- | Generate IO actions for the handlers.
    handlerActions :: [HandlerT] -> LogRecord -> String -> [IO ()]
    handlerActions :: [HandlerT] -> LogRecord -> String -> [IO ()]
    handlerActions [HandlerT]
    h LogRecord
    lr String
    loggername = (HandlerT -> IO ()) -> [HandlerT] -> [IO ()]
    forall a b. (a -> b) -> [a] -> [b]
    map (LogRecord -> String -> HandlerT -> IO ()
    callHandler LogRecord
    lr String
    loggername ) [HandlerT]
    h

    -- | Add handler to 'Logger'.  Returns a new 'Logger'.
    addHandler :: LogHandler a => a -> Logger -> Logger
    addHandler :: forall a. LogHandler a => a -> Logger -> Logger
    addHandler a
    h Logger
    l= Logger
    l{handlers = (HandlerT h) : (handlers l)}

    -- | Remove a handler from the 'Logger'.  Handlers are removed in the reverse
    -- order they were added, so the following property holds for any 'LogHandler'
    -- @h@:
    --
    -- > removeHandler . addHandler h = id
    --
    -- If no handlers are associated with the 'Logger', it is returned unchanged.
    --
    -- The root logger's default handler that writes every message to stderr can
    -- be removed by using this function before any handlers have been added
    -- to the root logger:
    --
    -- > updateGlobalLogger rootLoggerName removeHandler
    removeHandler :: Logger -> Logger
    removeHandler :: Logger -> Logger
    removeHandler Logger
    l =
        case [HandlerT]
    hs of [] -> Logger
    l
                   [HandlerT]
    _  -> Logger
    l{handlers = tail hs}
      where
        hs :: [HandlerT]
    hs = Logger -> [HandlerT]
    handlers Logger
    l

    -- | Set the 'Logger'\'s list of handlers to the list supplied.
    -- All existing handlers are removed first.
    setHandlers :: LogHandler a => [a] -> Logger -> Logger
    setHandlers :: forall a. LogHandler a => [a] -> Logger -> Logger
    setHandlers [a]
    hl Logger
    l =
        Logger
    l{handlers = map (\a
    h -> a -> HandlerT
    forall a. LogHandler a => a -> HandlerT
    HandlerT a
    h) hl}

    -- | Returns the "level" of the logger.  Items beneath this
    -- level will be ignored.

    getLevel :: Logger -> Maybe Priority
    getLevel :: Logger -> Maybe Priority
    getLevel Logger
    l = Logger -> Maybe Priority
    level Logger
    l

    -- | Sets the "level" of the 'Logger'.  Returns a new
    -- 'Logger' object with the new level.

    setLevel :: Priority -> Logger -> Logger
    setLevel :: Priority -> Logger -> Logger
    setLevel Priority
    p Logger
    l = Logger
    l{level = Just p}

    -- | Clears the "level" of the 'Logger'.  It will now inherit the level of
    -- | its parent.

    clearLevel :: Logger -> Logger
    clearLevel :: Logger -> Logger
    clearLevel Logger
    l = Logger
    l {level = Nothing}

    -- | Updates the global record for the given logger to take into
    -- account any changes you may have made.

    saveGlobalLogger :: Logger -> IO ()
    saveGlobalLogger :: Logger -> IO ()
    saveGlobalLogger Logger
    l = MVar LogTree -> (LogTree -> IO LogTree) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar LogTree
    logTree
                         (\LogTree
    lt -> LogTree -> IO LogTree
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LogTree -> IO LogTree) -> LogTree -> IO LogTree
    forall a b. (a -> b) -> a -> b
    $ String -> Logger -> LogTree -> LogTree
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Logger -> String
    name Logger
    l) Logger
    l LogTree
    lt)

    {- | Helps you make changes on the given logger.  Takes a function
    that makes changes and writes those changes back to the global
    database.  Here's an example from above (\"s\" is a 'LogHandler'):

    > updateGlobalLogger "MyApp.BuggyComponent"
    >                    (setLevel DEBUG . setHandlers [s])
    -}

    updateGlobalLogger :: String             -- ^ Logger name
                       -> (Logger -> Logger) -- ^ Function to call
                       -> IO ()
    updateGlobalLogger :: String -> (Logger -> Logger) -> IO ()
    updateGlobalLogger String
    ln Logger -> Logger
    func =
        do l <- String -> IO Logger
    getLogger String
    ln
           saveGlobalLogger (func l)

    -- | Allow graceful shutdown. Release all opened files, handlers, etc.
    removeAllHandlers :: IO ()
    removeAllHandlers :: IO ()
    removeAllHandlers =
        MVar LogTree -> (LogTree -> IO LogTree) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar LogTree
    logTree ((LogTree -> IO LogTree) -> IO ())
    -> (LogTree -> IO LogTree) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \LogTree
    lt -> do
            let allHandlers :: [HandlerT]
    allHandlers = (Logger -> [HandlerT] -> [HandlerT])
    -> [HandlerT] -> LogTree -> [HandlerT]
    forall a b k. (a -> b -> b) -> b -> Map k a -> b
    Map.foldr (\Logger
    l [HandlerT]
    r -> [[HandlerT]] -> [HandlerT]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[HandlerT]
    r, Logger -> [HandlerT]
    handlers Logger
    l]) [] LogTree
    lt
            (HandlerT -> IO ()) -> [HandlerT] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\(HandlerT a
    h) -> a -> IO ()
    forall a. LogHandler a => a -> IO ()
    close a
    h) [HandlerT]
    allHandlers
            LogTree -> IO LogTree
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LogTree -> IO LogTree) -> LogTree -> IO LogTree
    forall a b. (a -> b) -> a -> b
    $ (Logger -> Logger) -> LogTree -> LogTree
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (\Logger
    l -> Logger
    l {handlers = []}) LogTree
    lt

    {- | Traps exceptions that may occur, logging them, then passing them on.

    Takes a logger name, priority, leading description text (you can set it to
    @\"\"@ if you don't want any), and action to run.
    -}

    traplogging :: String                   -- ^ Logger name
                -> Priority                 -- ^ Logging priority
                -> String                   -- ^ Descriptive text to prepend to logged messages
                -> IO a                     -- ^ Action to run
                -> IO a                     -- ^ Return value
    traplogging :: forall a. String -> Priority -> String -> IO a -> IO a
    traplogging String
    logger Priority
    priority' String
    desc IO a
    action =
        let realdesc :: String
    realdesc = case String
    desc of
                                 String
    "" -> String
    ""
                                 String
    x -> String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": "
            handler :: Control.Exception.SomeException -> IO a
            handler :: forall a. SomeException -> IO a
    handler SomeException
    e = do
                        String -> Priority -> String -> IO ()
    logM String
    logger Priority
    priority' (String
    realdesc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e))
                        SomeException -> IO a
    forall a e. (HasCallStack, Exception e) => e -> a
    Control.Exception.throw SomeException
    e             -- Re-raise it
            in
            IO a -> (SomeException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch IO a
    action SomeException -> IO a
    forall a. SomeException -> IO a
    handler

    {- This function pulled in from MissingH to avoid a dep on it -}
    split :: Eq a => [a] -> [a] -> [[a]]
    split :: forall a. Eq a => [a] -> [a] -> [[a]]
    split [a]
    _ [] = []
    split [a]
    delim [a]
    str =
        let ([a]
    firstline, [a]
    remainder) = ([a] -> Bool) -> [a] -> ([a], [a])
    forall a. ([a] -> Bool) -> [a] -> ([a], [a])
    breakList ([a] -> [a] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [a]
    delim) [a]
    str
            in
            [a]
    firstline [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : case [a]
    remainder of
                                       [] -> []
                                       [a]
    x -> if [a]
    x [a] -> [a] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [a]
    delim
                                            then [] [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : []
                                            else [a] -> [a] -> [[a]]
    forall a. Eq a => [a] -> [a] -> [[a]]
    split [a]
    delim
                                                     (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]
    delim) [a]
    x)

    -- This function also pulled from MissingH
    breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
    breakList :: forall a. ([a] -> Bool) -> [a] -> ([a], [a])
    breakList [a] -> Bool
    func = ([a] -> Bool) -> [a] -> ([a], [a])
    forall a. ([a] -> Bool) -> [a] -> ([a], [a])
    spanList (Bool -> Bool
    not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Bool
    func)

    -- This function also pulled from MissingH
    spanList :: ([a] -> Bool) -> [a] -> ([a], [a])

    spanList :: forall a. ([a] -> Bool) -> [a] -> ([a], [a])
    spanList [a] -> Bool
    _ [] = ([],[])
    spanList [a] -> Bool
    func list :: [a]
    list@(a
    x:[a]
    xs) =
        if [a] -> Bool
    func [a]
    list
           then (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys,[a]
    zs)
           else ([],[a]
    list)
        where ([a]
    ys,[a]
    zs) = ([a] -> Bool) -> [a] -> ([a], [a])
    forall a. ([a] -> Bool) -> [a] -> ([a], [a])
    spanList [a] -> Bool
    func [a]
    xs