├── .gitignore ├── CHANGES.md ├── LICENSE ├── README.md ├── build.clj ├── deps.edn ├── src └── net │ └── lewisship │ ├── bench.clj │ ├── bench │ └── internal.clj │ ├── trace.clj │ └── trace │ └── impl.clj ├── test-resources └── data_readers.clj └── test ├── my └── example │ └── ring_handler.clj ├── net └── lewisship │ ├── bench_demo.clj │ ├── target.clj │ └── trace_test.clj └── user.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target/ 2 | *.asc 3 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # 1.4 - UNRELEASED 2 | 3 | Added new `bench` option: `:ratio?` (default true); when false, the ratio column is omitted. 4 | 5 | # 1.3 - 25 Apr 2024 6 | 7 | The `bench` option :round-robin? now defaults to false, not true. 8 | 9 | Bumped org.clj-commons/pretty dependency to version 2.6.0. 10 | 11 | *Breaking Changes* 12 | 13 | - Slight change to bench output: column titles are now centered 14 | - The spec :net.lewisship.bench/:bind-for-args has been renamed to :bench-for-args; the previous name was incorrect 15 | 16 | # 1.2 - 18 Mar 2024 17 | 18 | Added support for a tagged literal that traces a form to evaluate, and the result of the evaluation. 19 | 20 | Added the `bench-for` macro. 21 | 22 | # 1.1 - 8 Mar 2024 23 | 24 | Added the ability to enable tracing in specific namespaces even when the global tracing flag 25 | is false. 26 | 27 | Migrated to org.clj-commons/pretty. 28 | 29 | Added new `net.lewisship.bench` namespace with useful wrappers around 30 | [criterium](https://github.com/hugoduncan/criterium) for benchmarking. 31 | 32 | # v1.0 - 10 Mar 2022 33 | 34 | Initial release. 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2024 Howard Lewis Ship 2 | Copyright 2017 WalmartLabs 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # io.github.hlship/trace 2 | 3 | [![Clojars Project](https://img.shields.io/clojars/v/io.github.hlship/trace.svg)](https://clojars.org/io.github.hlship/trace) 4 | [![cljdoc badge](https://cljdoc.org/badge/io.github.hlship/trace)](https://cljdoc.org/d/io.github.hlship/trace) 5 | 6 | Another small library, this one improves the experience when using output to debug code using the REPL. 7 | 8 | In my experience, using `prn` to output debugging information works well enough in small cases, 9 | but doesn't scale when there is a lot of data to be printed, or a lot of threads are involved. 10 | It just becomes a jumble of output. 11 | 12 | `trace` is a macro that (when enabled), will use Clojure's `tap>` to (by default) output a pretty-printed map of data to the console. 13 | 14 | For example, consider this Ring handler function: 15 | 16 | ```clojure 17 | (ns my.example.ring-handler 18 | (:require [net.lewisship.trace :refer [trace]])) 19 | 20 | (defn handle-request 21 | [request] 22 | (trace 23 | :method (:request-method request) 24 | :uri (:uri request)) 25 | ;; Off to do some request handler type things 26 | ) 27 | ``` 28 | 29 | When invoked at runtime, the following console output will be produced: 30 | 31 | ```clojure 32 | {:in my.example.ring-handler/handle-request, 33 | :line 6, 34 | :thread "nREPL-session-c3dde1ce-ca19-4e78-95ad-d0e4beda61eb", 35 | :method :get, 36 | :uri "/status"} 37 | ``` 38 | 39 | `trace` has automatically identified the executing function name, the line number, and the thread; the remaining keys 40 | in the map are provided as key/value pairs in the `trace` call. 41 | 42 | Patterned after logging, `trace` calls may be compiled or not - when `net.lewisship.trace/*compile-trace*` is false 43 | (the default), the `trace` macro expands to nil. This means it is safe to leave `trace` calls in production code if 44 | it can be assured that they will not be compiled. 45 | 46 | Further, when compiled, if `net.lewisship.trace/*enable-trace*` is false then the map is not created or provided to `tap>`. 47 | 48 | Outputting the map via `pprint` is merely the default operation; `tap>` provides the flexibility to replace or augment what 49 | happens when `trace` is called. For example, a tap could `dissoc` the :thread key before pretty-printing, if the thread 50 | name is not interesting. 51 | 52 | In addition, there are `trace>` and `trace>>` macros used in threaded expressions (using `->` and `->>`). 53 | 54 | ## Per-Namespace Override 55 | 56 | `net.lewisship.trace/set-ns-override!` can be used to enable specific namespaces to be traced 57 | even when the global trace flag (via `set-enable-trace!`) is set to false. 58 | 59 | ## Tagged Literal 60 | 61 | Often, even using `trace` is a bit cumbersome; the #trace/result tagged literal precedes 62 | a form, and will `trace` the form and the result of evaluating the form, and evaluate to the result. 63 | 64 | Example: 65 | 66 | ``` 67 | (defn handle-request 68 | [request] 69 | (if (string/ends-with? #trace/result (:uri request) "/") 70 | {:status 401 71 | :body "Invalid request"}) 72 | (handle-resource-request (:uri request))) 73 | 74 | > (handle-request {:request-method :get :uri "/status"}) 75 | => {:status 200 ...} 76 | {:in my.example.ring-handler/handle-request, 77 | :line 11, 78 | :thread "nREPL-session-62724fb3-7086-49bb-9d8f-4b238de8d01e", 79 | :form (:uri request), 80 | :result "/status"} 81 | ``` 82 | 83 | To enable this feature, create a `data_readers.clj` resource with the following value (or merge this entry into your existing `data_readers.clj`): 84 | 85 | ``` 86 | {trace/result net.lewisship.trace/trace-result-reader} 87 | ``` 88 | 89 | You must have the above file, or you'll see a RuntimeException "No reader function for tag trace/result" when 90 | you load your namespace with the #trace/result tag. 91 | 92 | ## Benchmarking 93 | 94 | Even though io.github.hlship/trace is used for REPL-oriented testing, it also includes a wrapper around 95 | [Criterium](https://github.com/hugoduncan/criterium) to benchmark small snippets of code. 96 | 97 | The `net.lewisship.bench` namespace provides a simple `bench` macro. 98 | 99 | ``` 100 | (let [list-data (doall (map inc (range 1000))) 101 | vector-data (vec list-data) 102 | pred #(< 900 %) 103 | v1 (fn [pred coll] (first (filter pred coll))) 104 | v2 (fn [pred coll] (reduce (fn [_ v] (when (pred v) 105 | (reduced v))) 106 | nil coll))] 107 | (bench 108 | (v1 pred list-data) 109 | (v1 pred vector-data) 110 | (v2 pred list-data) 111 | (v2 pred vector-data))) 112 | ┏━━━━━━━━━━━━━━━━━━━━━━━┳━━━━━━━━━━┳━━━━━━━━━━━━━┳━━━━━━━━━┓ 113 | ┃ Expression ┃ Mean ┃ Var ┃ Ratio ┃ 114 | ┣━━━━━━━━━━━━━━━━━━━━━━━╋━━━━━━━━━━╋━━━━━━━━━━━━━╋━━━━━━━━━┫ 115 | ┃ (v1 pred list-data) ┃ 8.80 µs ┃ ± 1.10 µs ┃ 152.3 % ┃ 116 | ┃ (v1 pred vector-data) ┃ 11.29 µs ┃ ± 1.24 µs ┃ 195.4 % ┃ (slowest) 117 | ┃ (v2 pred list-data) ┃ 6.37 µs ┃ ± 800.42 ns ┃ 110.3 % ┃ 118 | ┃ (v2 pred vector-data) ┃ 5.78 µs ┃ ± 772.54 ns ┃ 100.0 % ┃ (fastest) 119 | ┗━━━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━┻━━━━━━━━━━━━━┻━━━━━━━━━┛ 120 | 121 | ``` 122 | 123 | The actual output uses some [ANSI fonts](https://github.com/clj-commons/pretty) to highlight the 124 | fastest and slowest expressions. The first argument to bench can be a map that provides options 125 | for how to execute the benchmarks, and how to format the result. 126 | 127 | The `bench-for` macro builds on this, using an implicit `for` to build the expressions; 128 | it does some re-writing of the expression that's reported in the table 129 | to capture the values for the symbols provided by the `for` bindings: 130 | 131 | ``` 132 | (let [inputs {:list (doall (map inc (range 1000))) 133 | :vector (vec (doall (map inc (range 1000))))} 134 | pred (fn [value] #(< % value)) 135 | v1 (fn [pred coll] (first (filter pred coll))) 136 | v2 (fn [pred coll] (reduce (fn [_ v] (when (pred v) 137 | (reduced v))) 138 | nil coll))] 139 | (bench-for [input [:list :vector] 140 | count [5 50 500]] 141 | (v1 (pred count) (input inputs)) 142 | (v2 (pred count) (input inputs)))) 143 | ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┳━━━━━━━━━━━┳━━━━━━━━━━━━┳━━━━━━━━━━━┓ 144 | ┃ Expression ┃ Mean ┃ Var ┃ Ratio ┃ 145 | ┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━╋━━━━━━━━━━━╋━━━━━━━━━━━━╋━━━━━━━━━━━┫ 146 | ┃ (v1 (pred 5) (:list inputs)) ┃ 283.33 ns ┃ ± 26.35 ns ┃ 1,550.5 % ┃ 147 | ┃ (v2 (pred 5) (:list inputs)) ┃ 50.85 ns ┃ ± 1.45 ns ┃ 278.3 % ┃ 148 | ┃ (v1 (pred 50) (:list inputs)) ┃ 455.43 ns ┃ ± 31.55 ns ┃ 2,492.3 % ┃ 149 | ┃ (v2 (pred 50) (:list inputs)) ┃ 49.92 ns ┃ ± 6.45 ns ┃ 273.2 % ┃ 150 | ┃ (v1 (pred 500) (:list inputs)) ┃ 456.72 ns ┃ ± 33.41 ns ┃ 2,499.4 % ┃ 151 | ┃ (v2 (pred 500) (:list inputs)) ┃ 49.32 ns ┃ ± 6.82 ns ┃ 269.9 % ┃ 152 | ┃ (v1 (pred 5) (:vector inputs)) ┃ 430.01 ns ┃ ± 37.79 ns ┃ 2,353.2 % ┃ 153 | ┃ (v2 (pred 5) (:vector inputs)) ┃ 18.27 ns ┃ ± 0.44 ns ┃ 100.0 % ┃ (fastest) 154 | ┃ (v1 (pred 50) (:vector inputs)) ┃ 462.37 ns ┃ ± 37.89 ns ┃ 2,530.3 % ┃ (slowest) 155 | ┃ (v2 (pred 50) (:vector inputs)) ┃ 19.48 ns ┃ ± 2.32 ns ┃ 106.6 % ┃ 156 | ┃ (v1 (pred 500) (:vector inputs)) ┃ 459.50 ns ┃ ± 34.11 ns ┃ 2,514.6 % ┃ 157 | ┃ (v2 (pred 500) (:vector inputs)) ┃ 18.68 ns ┃ ± 0.57 ns ┃ 102.2 % ┃ 158 | ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━┻━━━━━━━━━━━━┻━━━━━━━━━━━┛ 159 | ``` 160 | 161 | Notice how the `input` and `count` symbols have been replaced with a specific value 162 | for that execution? Be careful about using collections directly as inputs, as the (possibly infinite!) 163 | contents of those collections will be part of the expression printed in the first column. 164 | -------------------------------------------------------------------------------- /build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [net.lewisship.build :as b] 3 | [clojure.tools.build.api :as build])) 4 | 5 | (def lib 'io.github.hlship/trace) 6 | (def version "1.4") 7 | 8 | (def jar-params {:project-name lib 9 | :version version 10 | :scm 11 | {:url "https://github.com/hlship/trace" 12 | :license :asl}}) 13 | 14 | (defn clean 15 | [_params] 16 | (build/delete {:path "target"})) 17 | 18 | (defn jar 19 | [_params] 20 | (b/create-jar jar-params)) 21 | 22 | (defn deploy 23 | [_params] 24 | (clean nil) 25 | (b/deploy-jar (jar nil))) 26 | 27 | (defn codox 28 | [_params] 29 | (b/generate-codox {:project-name lib 30 | :version version})) 31 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.12.0"} 2 | org.clj-commons/pretty {:mvn/version "3.2.0"} 3 | criterium/criterium {:mvn/version "0.4.6"}} 4 | :aliases 5 | {;; clj -X:test 6 | :test 7 | {:extra-paths ["test" 8 | "test-resources"] 9 | :extra-deps {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" 10 | :git/sha "dfb30dd"} 11 | io.github.tonsky/clj-reload {:mvn/version "0.7.1"}} 12 | :exec-fn cognitect.test-runner.api/test} 13 | 14 | :nrepl 15 | {:extra-deps {nrepl/nrepl {:mvn/version "1.1.1"}} 16 | :extra-paths ["test-resources"] 17 | :main-opts ["-m" "nrepl.cmdline"]} 18 | 19 | ; clj -T:build 20 | :build 21 | {:deps {io.github.hlship/build-tools {:git/tag "0.10.2" :git/sha "3c446e4"}} 22 | :ns-default build}} 23 | 24 | :net.lewisship.build/scm 25 | {:url "https://github.com/hlship/trace" 26 | :license :asl} 27 | 28 | :codox/config 29 | {:description "Utility to assist with REPL-oriented debugging" 30 | :source-uri "https://github.com/hlship/trace/blob/master/{filepath}#L{line}"}} 31 | -------------------------------------------------------------------------------- /src/net/lewisship/bench.clj: -------------------------------------------------------------------------------- 1 | (ns net.lewisship.bench 2 | "Useful wrappers around criterium." 3 | {:added "1.1.0"} 4 | (:require [clojure.spec.alpha :as s] 5 | [clojure.walk :as walk] 6 | [criterium.core :as c] 7 | [net.lewisship.bench.internal :as i] 8 | [clj-commons.format.table :as table])) 9 | 10 | (defn- wrap-expr-as-block 11 | ;; blocks are what I call the inputs to criterium 12 | ([expr] 13 | (wrap-expr-as-block expr (str expr))) 14 | ([expr title] 15 | {:f `(fn [] ~expr) 16 | :expr-string title})) 17 | 18 | (defn- format-estimate 19 | [estimate] 20 | (let [mean (first estimate) 21 | [scale unit] (c/scale-time mean)] 22 | (format "%.2f %s" (* scale mean) unit))) 23 | 24 | (defn- format-estimate-sqrt 25 | [estimate] 26 | (let [mean (Math/sqrt (first estimate)) 27 | [scale unit] (c/scale-time mean)] 28 | (format "%.2f %s" (* scale mean) unit))) 29 | 30 | (defn- report 31 | [opts blocks results] 32 | (let [{:keys [sort? ratio?] 33 | :or {sort? false 34 | ratio? true}} opts 35 | fastest-mean (->> results 36 | (map #(-> % :mean first)) 37 | (reduce min)) 38 | lines (mapv (fn [i {:keys [expr-string]} {:keys [mean sample-variance]}] 39 | (let [simple-mean (first mean)] 40 | {:expression expr-string 41 | :mean simple-mean 42 | :ratio (format "%,.1f %%" 43 | (* 100.0 (/ simple-mean fastest-mean))) 44 | :row i 45 | :formatted-mean (format-estimate mean) 46 | :formatted-variance (str "± " (format-estimate-sqrt sample-variance))})) 47 | (iterate inc 0) blocks results) 48 | lines' (sort-by :mean lines) 49 | decorate? (not sort?) 50 | fastest-row (-> lines' first :row) 51 | slowest-row (-> lines' last :row)] 52 | 53 | (table/print-table 54 | (cond-> {:columns 55 | (cond-> [:expression 56 | {:key :formatted-mean 57 | :title "Mean"} 58 | {:key :formatted-variance 59 | :title "Var" 60 | :pad :left}] 61 | ratio? (conj {:key :ratio 62 | :pad :left}))} 63 | decorate? (assoc :default-decorator (fn [row _] 64 | (cond 65 | (= row fastest-row) 66 | :bright-green.bold 67 | 68 | (= row slowest-row) 69 | :yellow)) 70 | :row-annotator 71 | (fn [row _] 72 | (cond 73 | (= row fastest-row) 74 | [:bright-green.bold " (fastest)"] 75 | 76 | 77 | (= row slowest-row) 78 | [:yellow " (slowest)"])))) 79 | (if sort? 80 | lines' 81 | lines)))) 82 | 83 | (defn- benchmark-block 84 | [options block] 85 | (c/progress "Benchmarking" (:expr-string block) "...") 86 | (c/benchmark* (:f block) options)) 87 | 88 | (defn bench* 89 | "The core of the [[bench]] macro; the expressions to `bench` are converted into blocks, each a map 90 | with keys :f (a no-args function) and :expr-str (the string representation of the form being 91 | benchmarked)." 92 | [opts blocks] 93 | (let [{:keys [quick? progress? round-robin? report?] 94 | :or {quick? true 95 | round-robin? false 96 | report? true 97 | progress? false}} opts 98 | benchmark-options (merge (if quick? 99 | c/*default-quick-bench-opts* 100 | c/*default-benchmark-opts*) 101 | opts) 102 | results (binding [c/*report-progress* progress?] 103 | (if round-robin? 104 | (c/benchmark-round-robin* blocks benchmark-options) 105 | (mapv #(benchmark-block benchmark-options %) blocks)))] 106 | (if report? 107 | (report opts blocks results) 108 | results))) 109 | 110 | (defmacro bench 111 | "Benchmarks a sequence of expressions. Criterium is used to perform the benchmarking, 112 | then the results are reported in a tabular format, with the fastest and slowest 113 | expressions highlighted (marked in green and yellow, respectively). 114 | 115 | The first argument may be a map of options, rather than an expression to benchmark. 116 | 117 | Options: 118 | : :quick? If true (the default), used quick benchmarking options 119 | : :round-robin? If true (the default is false), uses round-robin testing of the expressions rather 120 | than running an independent benchmark for each expression. 121 | : report? If true (the default), print a report and return nil. Otherwise, 122 | returns a seq of benchmarking stats as returned by Criterium. 123 | : progress? If true (the default is false), enable Criterium progress reporting during benchmark 124 | collection. 125 | : sort? If true (the default is false), then when results are printed, they are 126 | sorted fastest to slowest (with no highlighting). 127 | : ratio? If true (the default), then in the report, the final column is a ratio of the row to the fastest row. 128 | 129 | In addition, the options are passed to Criterium, allowing overrides of the options 130 | it uses when benchmarking, such as :samples, etc." 131 | {:arglists '([& exprs] 132 | [opts & exprs])} 133 | [& exprs] 134 | (let [[expr & more-exprs] exprs 135 | [opts all-exprs] (if (map? expr) 136 | [expr more-exprs] 137 | [nil exprs])] 138 | (assert (every? list? all-exprs) 139 | "Each benchmarked expression must be a list (a function call)") 140 | (assert (seq all-exprs) 141 | "No expressions to benchmark") 142 | `(bench* ~opts ~(mapv wrap-expr-as-block all-exprs)))) 143 | 144 | (defn- form-expander 145 | [symbols form] 146 | `{:f (fn [] ~form) 147 | :expr-string (->> '~form 148 | (walk/postwalk-replace ~symbols) 149 | str)}) 150 | 151 | (s/def ::bench-for-args (s/cat 152 | :opts (s/? (s/nilable map?)) 153 | :bindings vector? 154 | :exprs (s/+ list?))) 155 | 156 | (defmacro bench-for 157 | "Often you will want to benchmark an expression (or set of expressions) 158 | while varying the exact values inside the expression; `bench-for` takes 159 | a vector of bindings, like `clojure.core/for` and builds a new list of 160 | expressions for each iteration of the `for`. The 161 | string version of the expression (used in the output report) 162 | will have the local symbols from the `for` replaced with the values for this iteration. 163 | 164 | Example: 165 | 166 | ``` 167 | (let [coll (range 1000)] 168 | (bench-for [n [5 50 500 5000]] 169 | (reduce + (take n coll)))) 170 | 171 | ``` 172 | 173 | Will be reported as four expressions: 174 | 175 | ``` 176 | (reduce + (take 5 coll)) 177 | (reduce + (take 50 coll)) 178 | (reduce + (take 500 coll)) 179 | (reduce + (take 5000 coll)) 180 | ``` 181 | 182 | Note that the expression is only modified for the string representation 183 | used in the report; the actual expression is executed unchanged." 184 | {:arglists '([bindings & exprs] 185 | [opts bindings & exprs])} 186 | [& args] 187 | (let [{:keys [opts bindings exprs]} (s/conform ::bench-for-args args) 188 | _ (when-not exprs 189 | (throw (ex-info "bench-for expects optional opts, then vector, then expressions" 190 | {:args args 191 | :explain (s/explain-data ::bench-for-args args)}))) 192 | symbols (gensym "symbols-") 193 | expanded (mapv #(form-expander symbols %) exprs) 194 | outer (-> &env keys set)] 195 | `(let [blocks# (reduce into [] 196 | (for [~@bindings 197 | :let [~symbols (i/capture-symbols ~outer)]] 198 | ;; Evaluate symbol map inside the `for` context 199 | ;; to map symbols to their values for the current 200 | ;; iteration of the for. 201 | ~expanded))] 202 | (bench* ~opts blocks#)))) 203 | -------------------------------------------------------------------------------- /src/net/lewisship/bench/internal.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc net.lewisship.bench.internal 2 | "Internal use; subject to change at any time." 3 | (:require [clojure.set :as set])) 4 | 5 | (defmacro capture-symbols 6 | [exclude-keys] 7 | (reduce (fn [m k] 8 | (if (contains? exclude-keys k) 9 | m 10 | (assoc m (list 'quote k) k))) 11 | {} 12 | (keys &env))) 13 | -------------------------------------------------------------------------------- /src/net/lewisship/trace.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) 2022-present Howard Lewis Ship. 2 | ; 3 | ; Licensed under the Apache License, Version 2.0 (the "License") 4 | ; you may not use this file except in compliance with the License. 5 | ; You may obtain a copy of the License at 6 | ; 7 | ; http://www.apache.org/licenses/LICENSE-2.0 8 | ; 9 | ; Unless required by applicable law or agreed to in writing, software 10 | ; distributed under the License is distributed on an "AS IS" BASIS, 11 | ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | ; See the License for the specific language governing permissions and 13 | ; limitations under the License. 14 | 15 | (ns net.lewisship.trace 16 | "Light-weight, asynchronous logging built around `clojure.core/tap>`. 17 | 18 | Follows the same pattern as `clojure.core/assert`: When tracing is not compiled, 19 | the tracing macros should create no runtime overhead. 20 | 21 | When tracing is compiled, a check occurs to see if tracing is enabled; only then 22 | do the most expensive operations (e.g., identifying the function containing the 23 | trace call) occur, as well as the call to `clojure.core/tap>`." 24 | (:require [net.lewisship.trace.impl :as impl :refer [emit-trace enabled?]] 25 | [clojure.pprint :refer [pprint]])) 26 | 27 | (def ^:dynamic *compile-trace* 28 | "If false (the default), calls to `trace` evaluate to nil (and `trace>` and `trace>>` simply return 29 | the threaded value)." 30 | false) 31 | 32 | (def ^:dynamic *enable-trace* 33 | "If false (the default is true) then compiled calls to `trace` (and `trace>` and `trace>>`) 34 | are a no-op." 35 | true) 36 | 37 | (defn set-compile-trace! 38 | "Sets the default value of the `*compile-trace*` var. 39 | 40 | Remember that after changing this, it may be necessary to re-load namespaces for the change to take effect." 41 | [value] 42 | (alter-var-root #'*compile-trace* (constantly value))) 43 | 44 | (defn set-enable-trace! 45 | "Sets the default value of the `*enable-trace*` var. 46 | 47 | Changes take effect immediately. 48 | 49 | When this global flag is true, tracing is enabled for all namespaces. 50 | When this flag is false, tracing is only enabled for namespaces specifically enabled via 51 | [[set-ns-override!]]." 52 | [value] 53 | (alter-var-root #'*enable-trace* (constantly value))) 54 | 55 | (defmacro trace 56 | "Calls to trace generate a map that is passed to `tap>`. 57 | 58 | The map includes keys: 59 | 60 | * :in - a symbol of the namespace and function 61 | * :line - the line number of the trace invocation (if available) 62 | * :thread - the string name of the current thread 63 | 64 | Additional keys and values may be supplied. 65 | 66 | `trace` expands to nil, if compilation is disabled. 67 | 68 | Any invocation of `trace` evaluates to nil." 69 | [& kvs] 70 | (assert (even? (count kvs)) 71 | "pass key/value pairs") 72 | (when *compile-trace* 73 | (let [ns-symbol (ns-name *ns*) 74 | {:keys [line]} (meta &form)] 75 | `(when (enabled? *enable-trace* '~ns-symbol) 76 | (emit-trace ~line ~@kvs))))) 77 | 78 | (defmacro trace> 79 | "A version of `trace` that works inside `->` thread expressions. Within the 80 | `trace>` body, `%` is bound to the threaded value. When compilation is disabled, 81 | it simply evaluates to the threaded value." 82 | [value & kvs] 83 | (assert (even? (count kvs)) 84 | "pass key/value pairs") 85 | (if-not *compile-trace* 86 | value 87 | (let [ns-symbol (ns-name *ns*) 88 | {:keys [line]} (meta &form)] 89 | `(let [~'% ~value] 90 | (when (enabled? *enable-trace* '~ns-symbol) 91 | (emit-trace ~line ~@kvs)) 92 | ~'%)))) 93 | 94 | (defmacro trace>> 95 | "A version of `trace` that works inside `->>` thread expressions. Within the 96 | `trace>>` body, `%` is bound to the threaded value. When compilation is disabled, 97 | it simply evaluates to the threaded value." 98 | ;; This is tricky because the value comes at the end due to ->> so we have to 99 | ;; work harder (fortunately, at compile time) to separate the value expression 100 | ;; from the keys and values. 101 | [& kvs-then-value] 102 | (let [value (last kvs-then-value) 103 | kvs (butlast kvs-then-value)] 104 | (assert (even? (count kvs)) 105 | "pass key/value pairs") 106 | (if-not *compile-trace* 107 | value 108 | (let [ns-symbol (ns-name *ns*) 109 | {:keys [line]} (meta &form)] 110 | `(let [~'% ~value] 111 | (when (enabled? *enable-trace* '~ns-symbol) 112 | (emit-trace ~line ~@kvs)) 113 | ~'%))))) 114 | 115 | 116 | (defn trace-result-reader 117 | "A reader for the #trace/result tagged literal. When compilation is off, 118 | returns the form unchanged. When compilation is enabled, it will trace 119 | the form (as :form) and its evaluation (as :result), and evaluate 120 | to the result." 121 | {:added "1.2.0"} 122 | [form] 123 | (if-not *compile-trace* 124 | form 125 | (let [result (gensym "result-") 126 | trace-call (with-meta 127 | `(trace :form '~form 128 | :result ~result) 129 | ;; Copy meta (line and location) so that trace can capture the line number 130 | (meta form))] 131 | `(let [~result ~form] 132 | ~trace-call 133 | ~result)))) 134 | 135 | (defn setup-default 136 | "Enables tracing output with a default tap of `pprint`." 137 | [] 138 | (set-compile-trace! true) 139 | (set-enable-trace! true) 140 | (add-tap pprint)) 141 | 142 | (defn set-ns-override! 143 | "Enables or disables tracing for a single namespace (by default, the current namespace). 144 | The namespace must be a simple symbol. Enabling tracing for a namespace overrides the 145 | global flag managed by [[set-enable-trace!]] (tracing occurs if either the global flag 146 | is true, or the namespace is specifically enabled). 147 | 148 | Manages a set of namespaces that are enabled in this way." 149 | {:added "1.1"} 150 | ([] 151 | (set-ns-override! true)) 152 | ([enabled?] 153 | (set-ns-override! (ns-name *ns*) enabled?)) 154 | ([ns-symbol enabled?] 155 | (impl/set-ns-enabled! ns-symbol enabled?))) 156 | 157 | -------------------------------------------------------------------------------- /src/net/lewisship/trace/impl.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) 2022-present Howard Lewis Ship. 2 | ; 3 | ; Licensed under the Apache License, Version 2.0 (the "License") 4 | ; you may not use this file except in compliance with the License. 5 | ; You may obtain a copy of the License at 6 | ; 7 | ; http://www.apache.org/licenses/LICENSE-2.0 8 | ; 9 | ; Unless required by applicable law or agreed to in writing, software 10 | ; distributed under the License is distributed on an "AS IS" BASIS, 11 | ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | ; See the License for the specific language governing permissions and 13 | ; limitations under the License. 14 | 15 | (ns ^:no-doc net.lewisship.trace.impl 16 | (:require [clj-commons.format.exceptions :refer [format-stack-trace-element]] 17 | [clojure.string :as string])) 18 | 19 | (def *enabled-namespaces (atom #{})) 20 | 21 | (defn set-ns-enabled! 22 | [ns-symbol flag] 23 | {:pre [(simple-symbol? ns-symbol)]} 24 | (let [op (if flag conj disj)] 25 | (swap! *enabled-namespaces op ns-symbol)) 26 | nil) 27 | 28 | (defn enabled? 29 | [global-flag current-ns] 30 | (or global-flag 31 | (contains? @*enabled-namespaces (ns-name current-ns)))) 32 | 33 | (defn ^:private in-trace-ns? 34 | [^StackTraceElement frame] 35 | (string/starts-with? (.getClassName frame) "net.lewisship.trace.impl$")) 36 | 37 | (defn extract-in 38 | [] 39 | (let [element (->> (Thread/currentThread) 40 | .getStackTrace 41 | (drop 1) ; Thread/getStackTrace 42 | (drop-while in-trace-ns?) 43 | first) 44 | frame-name (format-stack-trace-element element)] 45 | (symbol frame-name))) 46 | 47 | (defmacro emit-trace 48 | [trace-line & kvs] 49 | ;; Maps are expected to be small; array-map ensures that the keys are in insertion order. 50 | `(do 51 | (tap> (array-map 52 | :in (extract-in) 53 | ~@(when trace-line [:line trace-line]) 54 | :thread (.getName (Thread/currentThread)) 55 | ~@kvs)) 56 | nil)) 57 | -------------------------------------------------------------------------------- /test-resources/data_readers.clj: -------------------------------------------------------------------------------- 1 | {trace/result net.lewisship.trace/trace-result-reader} -------------------------------------------------------------------------------- /test/my/example/ring_handler.clj: -------------------------------------------------------------------------------- 1 | (ns my.example.ring-handler 2 | (:require [clojure.string :as string] 3 | [net.lewisship.trace :as trace :refer [trace]])) 4 | 5 | (trace/setup-default) 6 | 7 | (defn handle-resource-request [uri]) 8 | 9 | (defn handle-request 10 | [request] 11 | (if (string/ends-with? #trace/result (:uri request) "/") 12 | {:status 401 13 | :body "Invalid request"}) 14 | (handle-resource-request (:uri request))) 15 | 16 | (comment 17 | (handle-request {:request-method :get :uri "/status"}) 18 | 19 | *data-readers* 20 | ) -------------------------------------------------------------------------------- /test/net/lewisship/bench_demo.clj: -------------------------------------------------------------------------------- 1 | (ns net.lewisship.bench-demo 2 | (:require [net.lewisship.bench :as bench :refer [bench* bench bench-for]])) 3 | 4 | (comment 5 | 6 | (let [list-data (doall (map inc (range 1000))) 7 | vector-data (vec list-data) 8 | pred #(< 900 %) 9 | v1 (fn [pred coll] (first (filter pred coll))) 10 | v2 (fn [pred coll] (reduce (fn [_ v] (when (pred v) 11 | (reduced v))) 12 | nil coll))] 13 | (bench 14 | (v1 pred list-data) 15 | (v1 pred vector-data) 16 | (v2 pred list-data) 17 | (v2 pred vector-data))) 18 | 19 | (bench {:sort? true} (reduce + 0 (range 0 10000)) 20 | (+ 1 3) 21 | (apply * (range 1 20)) 22 | (mapv inc (range 0 1000))) 23 | 24 | ;; Fast experiment with the output side. 25 | ;; This is where I confirmed that IntelliJ's console (not just Cursive's) doesn't handle 26 | ;; ANSI codes properly. Fixed in pretty 3.2.0. 27 | 28 | (#'bench/report {:ratio? false :sort? true} 29 | [{:expr-string "first"} 30 | {:expr-string "second"} 31 | {:expr-string "third"}] 32 | '[{:mean [4.266282183424485E-5 (4.245749474127051E-5 4.310133277240219E-5)], 33 | :sample-variance [1.4094970219502932E-13 (0.0 0.0)]} 34 | {:mean [5.266282183424485E-5 (4.245749474127051E-5 4.310133277240219E-5)], 35 | :sample-variance [1.4094970219502932E-13 (0.0 0.0)]} 36 | #_{:mean [7.17364466888305E-9 (7.128314456370565E-9 7.253923221472023E-9)], 37 | :sample-variance [7.067038554971197E-21 (0.0 0.0)]} 38 | {:mean [1.2077515200737978E-5 (1.1952211907913209E-5 1.2175522861268199E-5)], 39 | :sample-variance [2.3028652061321932E-14 (0.0 0.0)]}]) 40 | 41 | 42 | (macroexpand-1 43 | '(bench-for [x (range 2)] 44 | (+ x x) 45 | (* x x))) 46 | 47 | (bench-for {:progress? true} 48 | [x (range 3) 49 | y (range 0 x)] 50 | (+ y x) 51 | (* x y)) 52 | 53 | (with-redefs [bench* prn] 54 | (let [coll (range 1000)] 55 | (bench-for nil [{n :count} [{:count 5} {:count 50}]] 56 | (reduce + (take n coll)))) 57 | 58 | ) 59 | 60 | (let [inputs {:list (doall (map inc (range 1000))) 61 | :vector (vec (doall (map inc (range 1000))))} 62 | pred (fn [value] #(< % value)) 63 | v1 (fn [pred coll] (first (filter pred coll))) 64 | v2 (fn [pred coll] (reduce (fn [_ v] (when (pred v) 65 | (reduced v))) 66 | nil coll))] 67 | (bench-for [input [:list :vector] 68 | count [5 50 500]] 69 | (v1 (pred count) (input inputs)) 70 | (v2 (pred count) (input inputs)))) 71 | 72 | (bench-for false) 73 | ) 74 | 75 | 76 | -------------------------------------------------------------------------------- /test/net/lewisship/target.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) 2022-present Howard Lewis Ship. 2 | ; 3 | ; Licensed under the Apache License, Version 2.0 (the "License") 4 | ; you may not use this file except in compliance with the License. 5 | ; You may obtain a copy of the License at 6 | ; 7 | ; http://www.apache.org/licenses/LICENSE-2.0 8 | ; 9 | ; Unless required by applicable law or agreed to in writing, software 10 | ; distributed under the License is distributed on an "AS IS" BASIS, 11 | ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | ; See the License for the specific language governing permissions and 13 | ; limitations under the License. 14 | ; 15 | (ns net.lewisship.target 16 | "Used to test per-namespace tracing enablement." 17 | (:require [net.lewisship.trace :refer [trace]])) 18 | 19 | (defn do-work 20 | [] 21 | (trace :here :i-am)) 22 | 23 | (comment 24 | (macroexpand-1 '(trace :foo :bar)) 25 | 26 | ) 27 | -------------------------------------------------------------------------------- /test/net/lewisship/trace_test.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) 2022-present Howard Lewis Ship. 2 | ; 3 | ; Licensed under the Apache License, Version 2.0 (the "License") 4 | ; you may not use this file except in compliance with the License. 5 | ; You may obtain a copy of the License at 6 | ; 7 | ; http://www.apache.org/licenses/LICENSE-2.0 8 | ; 9 | ; Unless required by applicable law or agreed to in writing, software 10 | ; distributed under the License is distributed on an "AS IS" BASIS, 11 | ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | ; See the License for the specific language governing permissions and 13 | ; limitations under the License. 14 | 15 | (ns net.lewisship.trace-test 16 | (:require 17 | [clojure.test :refer [deftest is]] 18 | [net.lewisship.trace :as t 19 | :refer [trace trace> trace>> *compile-trace* *enable-trace*]] 20 | [net.lewisship.target :as target] 21 | [net.lewisship.trace.impl :as impl])) 22 | 23 | ;; Note: these tests may fail if executed from REPL (and trace compilation 24 | ;; is enabled). 25 | 26 | (deftest trace-uncompiled-is-nil 27 | (binding [*compile-trace* false] 28 | (is (= nil 29 | (macroexpand-1 `(trace :foo 1 :bar 2)))))) 30 | 31 | ;; Because line numbers are embedded, any changes above this line may make the lines below fail. 32 | 33 | ;; Disabled tests because work in Cursive but not from CLI. Macros are tricky. 34 | 35 | ;; These are now further out of date due to changes related to set-ns-override! 36 | 37 | #_ 38 | (deftest trace-with-compile-enabled 39 | (binding [*compile-trace* true] 40 | (is (= `(impl/emit-trace *enable-trace* 35 :foo 1 :bar 2) 41 | (macroexpand-1 '(trace :foo 1 :bar 2)))) 42 | 43 | (is (= `(let [~'% ~'n] (impl/emit-trace *enable-trace* 38 :value ~'% :foo 1) ~'%) 44 | (macroexpand-1 '(trace> n :value % :foo 1)))) 45 | 46 | (is (= `(let [~'% ~'n] (impl/emit-trace *enable-trace* 41 :value ~'% :bar 2) ~'%) 47 | (macroexpand-1 '(trace>> :value % :bar 2 n)))))) 48 | 49 | #_ 50 | (deftest emit-trace-expansion 51 | (binding [*compile-trace* true] 52 | (is (= `(when ~'flag? 53 | (tap> (array-map 54 | :in (impl/extract-in) 55 | :line 99 56 | :thread (.getName (java.lang.Thread/currentThread)) 57 | :x 1 58 | :y 2)) 59 | nil) 60 | (macroexpand-1 '(impl/emit-trace flag? 99 :x 1 :y 2)))) 61 | 62 | ;; When line number is not known: 63 | (is (= `(when ~'flag? 64 | (tap> (array-map 65 | :in (impl/extract-in) 66 | :thread (.getName (java.lang.Thread/currentThread)) 67 | :x 1 68 | :y 2)) 69 | nil) 70 | (macroexpand-1 '(impl/emit-trace flag? nil :x 1 :y 2)))))) 71 | 72 | ;; The rest are just experiments used to manually test the macro expansions. 73 | 74 | (defn calls-trace 75 | [] 76 | (trace :msg "called")) 77 | 78 | (defn calls-trace> 79 | [] 80 | (-> {:value 1} 81 | (update :value inc) 82 | (trace> :data % :label :post-inc) 83 | (assoc :after true))) 84 | 85 | (defn calls-trace>> 86 | [] 87 | (->> (range 10) 88 | (map inc) 89 | (trace>> :values % :label :post-inc) 90 | (partition 2))) 91 | 92 | (defn calls-extract-in 93 | [] 94 | (impl/extract-in)) 95 | 96 | (deftest identifies-trace-location 97 | (is (= 'net.lewisship.trace-test/calls-extract-in 98 | (calls-extract-in)))) 99 | 100 | (comment 101 | 102 | (set! *print-meta* true) 103 | ;; Rest of this is very tricky to automated test due to dynamic nature of the macros. 104 | 105 | (calls-trace) 106 | ;; no output 107 | 108 | (t/setup-default) 109 | ;; Reload this NS to test the remainder: 110 | 111 | (macroexpand-1 '(trace :msg "hello")) 112 | (clojure.walk/macroexpand-all '(trace :msg "hello")) 113 | 114 | (calls-trace) ; => nil 115 | ;; {:in net.lewisship.trace-test/calls-trace, 116 | ;; :line 23, 117 | ;; :thread "nREPL-session-e439a250-d27a-474b-a694-69a97dbe5572", 118 | ;; :msg "called"} 119 | 120 | (t/set-ns-override!) 121 | (t/set-enable-trace! false) 122 | 123 | (calls-trace) ; => nil 124 | 125 | 126 | (calls-trace>) ; => {:value 2, :after true } 127 | ;; {:in net.lewisship.trace-test/calls-trace>, 128 | ;; :line 25, 129 | ;; :thread "nREPL-session-e439a250-d27a-474b-a694-69a97dbe5572", 130 | ;; :data {:value 2}, 131 | ;; :label :post-inc} 132 | (macroexpand-1 '(trace> :value :foo :bar)) 133 | 134 | (calls-trace>>) ; => ((1 2) (3 4) (5 6) (7 8) (9 10)) 135 | ;; {:in net.lewisship.trace-test/calls-trace>>, 136 | ;; :line 32, 137 | ;; :thread "nREPL-session-e439a250-d27a-474b-a694-69a97dbe5572", 138 | ;; :values (1 2 3 4 5 6 7 8 9 10), 139 | ;; :label :post-inc} 140 | (macroexpand-1 '(trace>> :foo :bar :value)) 141 | 142 | (calls-extract-in) ;; ==> net.lewisship.trace-test/calls-extract-in 143 | 144 | (target/do-work) 145 | ) 146 | -------------------------------------------------------------------------------- /test/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [clj-commons.pretty.repl :as repl])) 3 | 4 | (repl/install-pretty-exceptions) 5 | --------------------------------------------------------------------------------