Amazing Clj/Cljs thread-safe log message capturing

capture.clj

(ns metabase.util.log.capture
  (:require [clojure.string :as str]))

(def ^:dynamic *capture-logs-fn*
  (constantly nil))

(defn level->int [level]
  (case level
    :explode 0
    :fatal   1
    :error   2
    :info    3
    :debug   4
    :trace   5
    :whisper 6))

(defn- capture-logs-fn [logs namespace-to-log level-to-log]
  (fn [a-namespace a-level]
    (when (<= (level->int a-level) (level->int level-to-log))
      (when (str/starts-with? a-namespace namespace-to-log)
        (fn [e message]
          (swap! logs conj {:namespace (symbol a-namespace)
                            :level     a-level
                            :e         e
                            :message   message}))))))

(defn do-with-log-messages-for-level [namespace-to-log level-to-log f]
  (let [logs           (atom [])
        old-capture-fn *capture-logs-fn*
        capture-fn     (capture-logs-fn logs namespace-to-log level-to-log)]
    (binding [*capture-logs-fn* (fn [a-message a-level]
                                  (let [f1 (old-capture-fn a-message a-level)
                                        f2 (capture-fn a-message a-level)]
                                    (cond
                                      (and f1 f2) (fn [e message]
                                                    (f1 e message)
                                                    (f2 e message))
                                      f1          f1
                                      f2          f2)))]
      (f (fn [] @logs)))))

(defmacro with-log-messages-for-level [[messages-binding ns-str level] & body]
  `(do-with-log-messages-for-level ~ns-str ~level (fn [~messages-binding] ~@body)))

(defn capture-logp! [f x & more]
  (let [[e & args] (if (instance? #?(:clj Throwable :cljs js/Error) x)
                     (cons x more)
                     (list* nil x more))]
    (f e args)))

(defmacro capture-logp [namespace-str level & args]
  `(when-let [f# (*capture-logs-fn* ~namespace-str ~level)]
     (capture-logp! f# ~(vec args))))

(defmacro logp [namespace-str level & args]
  `(do
     (capture-logp ~namespace-str ~level ~@args)
     (println ~(str "[TRACE " namespace-str "]") ~@args)))

(defmacro trace [& args]
  `(logp ~(str (ns-name *ns*)) :trace ~@args))

(trace "a picture")
;; =>
;; [TRACE metabase.util.log.capture] a picture

(with-log-messages-for-level [messages "metabase.util.log.capture" :debug]
  (println "MESSAGES =>" (pr-str (messages)))
  (trace "a picture")
  (println "MESSAGES =>" (pr-str (messages))))
;; => 
;; MESSAGES => []
;; [TRACE metabase.util.log.capture] a picture
;; MESSAGES => []

(with-log-messages-for-level [messages "metabase.util.log.capture" :trace]
  (println "MESSAGES =>" (pr-str (messages)))
  (trace "a picture")
  (println "MESSAGES =>" (pr-str (messages))))
;; =>
;; MESSAGES => []
;; [TRACE metabase.util.log.capture] a picture
;; MESSAGES => [{:namespace metabase.util.log.capture, :level :trace, :e nil, :message (["a picture"])}]

(with-log-messages-for-level [messages-1 "metabase.util" :trace]
  (with-log-messages-for-level [messages-2 "metabase.util.log.capture" :debug]
    (println "MESSAGES 1 =>" (pr-str (messages-1)))
    (println "MESSAGES 2 =>" (pr-str (messages-2)))
    (trace "a picture")
    (println "MESSAGES 1 =>" (pr-str (messages-1)))
    (println "MESSAGES 2 =>" (pr-str (messages-2)))))
;; =>
;; MESSAGES 1 => []
;; MESSAGES 2 => []
;; [TRACE metabase.util.log.capture] a picture
;; MESSAGES 1 => [{:namespace metabase.util.log.capture, :level :trace, :e nil, :message (["a picture"])}]
;; MESSAGES 2 => []

(with-log-messages-for-level [messages-1 "metabase.util" :debug]
  (with-log-messages-for-level [messages-2 "metabase.util.log.capture" :trace]
    (println "MESSAGES 1 =>" (pr-str (messages-1)))
    (println "MESSAGES 2 =>" (pr-str (messages-2)))
    (trace "a picture")
    (println "MESSAGES 1 =>" (pr-str (messages-1)))
    (println "MESSAGES 2 =>" (pr-str (messages-2)))))
;; =>
;; MESSAGES 1 => []
;; MESSAGES 2 => []
;; [TRACE metabase.util.log.capture] a picture
;; MESSAGES 1 => []
;; MESSAGES 2 => [{:namespace metabase.util.log.capture, :level :trace, :e nil, :message (["a picture"])}]

macroexpansion.clj

(macroexpand `(trace "a picture"))
;; =>
(do
  (when-let [f# (metabase.util.log.capture/*capture-logs-fn* "metabase.util.log.capture" :trace)]
    (metabase.util.log.capture/capture-logp! f# ["a picture"]))
  (println "[TRACE metabase.util.log.capture]" "a picture"))

Basic idea is we have a dynamic variable called capture-logs-fn with the signature

(f namespace-str level)

and if the logs should be captured at that level, it returns a function with the signature

(f e message)

that you should call with the logged exception (if any) and logged message to capture the message.

Then the actual implementation can basically compose capture-logs-fn so you can have multiple functions capturing logs.

The impl can store the logs in an atom or whatever that you can get later

This is a rough idea, still needs a few tweaks

• Setting the level for something like metabase probably shouldn't capture metabase-enterprise.x, right? So instead of (str/starts-with? x y) we probably want something like (or (= x y) (str/starts-with? x (str y "."))
• Needs the logf implementation
• Since we need to convert log levels to ints to do the >= comparison, we should consider doing that right in the macroexpansions themselves, so we don't have to do that conversion every time we hit a log/ form
• Macro syntax should be improved, e.g. accept just level (default to setting the root logger), or just a namespace (default to capturing everything, i.e. level is :trace), and namespace should be allowed to be a symbol. I think syntax should be [binding namespace-and-level] (pairs, like let, and it should support multiple bindings if for some insane reason you need that