-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.clj
56 lines (48 loc) · 1.75 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(ns hashp.core
(:require [clj-stacktrace.core :as stacktrace]
[clojure.walk :as walk]
[net.cgrand.macrovich :as macrovich]
[puget.printer :as puget]
[puget.color.ansi :as color]
[zprint.core :as zprint]))
(defn current-stacktrace []
(->> (.getStackTrace (Thread/currentThread))
(drop 3)
(stacktrace/parse-trace-elems)))
(defn trace-str [trace]
(when-let [t (first (filter :clojure trace))]
(str "[" (:ns t) "/" (:fn t) ":" (:line t) "]")))
(def result-sym (gensym "result"))
(defn- hide-p-form [form]
(if (and (seq? form)
(vector? (second form))
(= (-> form second first) result-sym))
(-> form second second)
form))
(def lock (Object.))
(def prefix (color/sgr "#p" :red))
(def print-opts
(merge puget/*options*
{:print-color true
:namespace-maps true
:color-scheme
{:nil [:bold :blue]}}))
(defn p* [form]
(let [orig-form (walk/postwalk hide-p-form form)]
`(let [~result-sym ~form]
(macrovich/case
:clj (locking lock
(println
(str prefix
(color/sgr (trace-str (current-stacktrace)) :green) " "
(when-not (= ~result-sym '~orig-form)
(str (puget/pprint-str '~orig-form print-opts) " => "))
(puget/pprint-str ~result-sym print-opts)))
~result-sym)
:cljs (do
(println
(str prefix " "
(when-not (= ~result-sym '~orig-form)
(str (zprint/zprint-str '~orig-form print-opts) " => "))
(zprint/zprint-str ~result-sym print-opts)))
~result-sym)))))