Probe in Clojure

common.cljc

(ns common
  "This namespace was made to provide utilities, which would be used often enough
   in both clj & cljs, but they are either not available in `clojure.core`
   & `cljs.core` OR they are available slightly differently and this namespace
   allows writing code with less reader-conditionals."
  (:require
    [medley.core :as medley]
    #?@(:cljs
        [[oops.core :refer [gcall]]
         ;; https://martinklepsch.org/posts/requiring-closure-namespaces.html
         [goog.string.format]
         [goog.string]
         [cljs.repl]]

        :clj
        [[clojure.data.json :as json]])
    [clojure.core.protocols]
    [clojure.spec.alpha :as s]
    [clojure.set :as set]
    [clojure.string :as str]
    [clojure.pprint :as pp]
    [clojure.walk :as walk])

  #?(:clj (:import
            (java.io ByteArrayOutputStream FileNotFoundException)
            (java.time Instant Duration ZoneId LocalDateTime)
            (java.lang.management ManagementFactory)
            (java.util UUID)
            (java.util.regex Pattern)
            (java.math RoundingMode))))

(def home-dir
  #?(:clj  (System/getProperty "user.home")
     :cljs "/"))

(def fmt
  "Cross-runtime version of `clojure.core/format`."
  #?(:clj  format
     :cljs goog.string/format))

(defmacro >stderr [& body] `(binding [*out* *err*] ~@body))

(defn- clojure-core-based-puget-options
  "NOTE: clojure.core/*print-level* doesn't have an equivalent in Puget 1.3.4."
  []
  {:seq-limit      *print-length*
   :coll-limit     *print-length*
   :namespace-maps *print-namespace-maps*})

(def ^:private pretty-printer-fn
  "Delay loading the pretty-printer namespaces until they are actually used,
   to reduce process startup time."
  (delay (or #?(:clj (try (fn puget-cprint [value & [opts]]
                            ((requiring-resolve 'puget.printer/cprint)
                             value
                             ;; Puget doesn't consider some *print-** settings,
                             ;; so we translate their values to the corresponding
                             ;; puget settings at the time of the print call.
                             (merge (clojure-core-based-puget-options) opts)))
                          (catch FileNotFoundException _)))
             pp/pprint)))

(defn pp
  "Pretty-print val, preferably in color, if the puget lib is available."
  ([val]
   (@pretty-printer-fn val))
  ([val opts-or-writer]
   (@pretty-printer-fn val opts-or-writer)))

(defn drop-top-clojure-fn-stack-frames
  "Remove elements from the top of a stacktrace, if
   1. they belong to the same Clojure function as the 1st element
   2. they are a `clojure.core` function

   For functions with a single signature, there are a pair of trace elements
   (unless the function was AOT compiled):
   1. :methodName \"invokeStatic\"
   2. :methodName \"invoke\"

   If the function defines multiple signatures, they often call each other,
   so there might be multiple pairs of invokeStatic & invoke trace elements.
   "
  [[first-trace-elem :as stack-trace]]
  (let [first-fn-classname (.getClassName first-trace-elem)]
    (drop-while
      (fn [trace-elem]
        (let [classname (.getClassName trace-elem)]
          (or (-> classname (= first-fn-classname))
              (-> classname (->> (re-find #"^clojure\.(lang|core\$)"))))))
      stack-trace)))

(defn ?
  "It's meant to be easily dropped into a thread-first form to pretty-print
   the data flowing through it, without effecting the computation's result.

   Sometimes the value would be inconvenient to print, so we want to transform
   it before printing.

   While this can be achieved using `doto`:
       (-> ... (doto (-> xform ?)) ...)

   `?` accepts an optional `xform` argument:
       (-> ... (? xform) ...)

   To distinguish multiple calls to `?`, we can specify a `msg` to be printed
   in a heading above the output.

   If `xform` is just a keyword or a var, `?` uses their string form as a `msg`.

   Functions can't be pretty-printed, but if they are bound to a var,
   we can just use that instead, and they will become the `msg`:

       (-> ... (? #'some-ns-alias/xform) ...)

   will print a heading like this:

       === #'some.fully.qualified.ns/xform ===

   Alternatively, we can also provide a custom, concise message for the heading
   explicitly, as a 3rd argument."
  ([x] (? x "PROBE"))

  ([x xform|msg]
   (if (string? xform|msg)
     (? x identity xform|msg)
     (? x xform|msg (if ((some-fn var? keyword?) xform|msg)
                      (str xform|msg)
                      "PROBE"))))

  ([x xform msg]
   ;; Print info about call-site
   (let [[call-site] #?(:clj  (-> (Throwable.) .getStackTrace
                                  drop-top-clojure-fn-stack-frames)
                        :cljs [nil])]
     (println (fmt "\n=== %s ===" msg))
     (when call-site
       (println " at" (.toString call-site))))
   (pp (xform x))
   x))

(def probe ?)