log.clj

(ns vilect.log
  (:require
    [clojure.walk :as walk])
  (:import
    (net.logstash.logback.argument StructuredArgument StructuredArguments)
    (org.slf4j Logger LoggerFactory)))

(set! *warn-on-reflection* true)

(defprotocol LoggerSource
  (-level-enabled? [t level-key]
    "Given the log level as a keyword, return a boolean if that log level is currently enabled.")
  (-trace [t msg data-map] [t msg data-map exception])
  (-debug [t msg data-map] [t msg data-map exception])
  (-info [t msg data-map] [t msg data-map exception])
  (-warn [t msg data-map] [t msg data-map exception])
  (-error [t msg data-map] [t msg data-map exception]))

(extend-protocol LoggerSource
  Logger
  (-level-enabled? [t level-key]
    (case level-key
      :trace (.isTraceEnabled t)
      :debug (.isDebugEnabled t)
      :info (.isInfoEnabled t)
      :warn (.isWarnEnabled t)
      :error (.isErrorEnabled t)))
  (-trace
    ([t msg data-map]
     (.trace t ^String msg ^StructuredArgument (StructuredArguments/entries data-map)))
    ([t msg data-map exception]
     (.trace t ^String msg ^StructuredArgument (StructuredArguments/entries data-map) ^Throwable exception)))
  (-debug
    ([t msg data-map]
     (.debug t ^String msg ^StructuredArgument (StructuredArguments/entries data-map)))
    ([t msg data-map exception]
     (.debug t ^String msg ^StructuredArgument (StructuredArguments/entries data-map) ^Throwable exception)))
  (-info
    ([t msg data-map]
     (.info t ^String msg ^StructuredArgument (StructuredArguments/entries data-map)))
    ([t msg data-map exception]
     (.info t ^String msg ^StructuredArgument (StructuredArguments/entries data-map) ^Throwable exception)))
  (-warn
    ([t msg data-map]
     (.warn t ^String msg ^StructuredArgument (StructuredArguments/entries data-map)))
    ([t msg data-map exception]
     (.warn t ^String msg ^StructuredArgument (StructuredArguments/entries data-map) ^Throwable exception)))
  (-error
    ([t msg data-map]
     (.error t ^String msg ^StructuredArgument (StructuredArguments/entries data-map)))
    ([t msg data-map exception]
     (.error t ^String msg ^StructuredArgument (StructuredArguments/entries data-map) ^Throwable exception))))

(defn maybe-stringify-val
  [x]
  (cond
    (string? x) x
    (qualified-ident? x) (str (namespace x) "/" (name x))
    (ident? x) (name x)
    (record? x) (into {} x)
    :else x))

(defprotocol Sanitize
  "A protocol with a method for sanitizing self for serializing.
   Some objects, such as InternalHttpClient, that are part of ex-info data, cannot be serialized by Jackson when
   logging. These types should implement this protocol in such a way that the returned value can be serialized."
  (sanitize [x]))

(extend-protocol Sanitize
  org.apache.http.impl.client.InternalHttpClient
  (sanitize [x] (str x))
  Object
  (sanitize [x] x)
  nil
  (sanitize [_] nil))

(defmacro logp
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [level msg & [data-map exception]]
  (let [log-method' (symbol (str "vilect.log/-" (name level)))]
    `(let [logger# (LoggerFactory/getLogger (str ~*ns*))]
       (when (-level-enabled? logger# ~level)
         (let [msg#            (maybe-stringify-val ~msg)
               exception-data# (ex-data ~exception)
               data-map#       (walk/prewalk
                                 (comp sanitize maybe-stringify-val)
                                 (cond-> ~data-map
                                   exception-data# (assoc :exception-data exception-data#)))]
           (~log-method' logger# msg# data-map# ~exception))))))

(defmacro trace
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [& args]
  `(logp :trace ~@args))

(defmacro debug
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [& args]
  `(logp :debug ~@args))

(defmacro info
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [& args]
  `(logp :info ~@args))

(defmacro warn
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [& args]
  `(logp :warn ~@args))

(defmacro error
  {:arglists '([msg] [msg data-map] [msg data-map exception])}
  [& args]
  `(logp :error ~@args))