This repository has been archived by the owner on Aug 21, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 6
/
spiral-stacktrace.el
286 lines (242 loc) · 11.5 KB
/
spiral-stacktrace.el
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
;;; spiral-stacktrace.el --- Stacktraces display -*- lexical-binding: t; -*-
;;
;; Filename: spiral-stacktrace.el
;; Author: Daniel Barreto <daniel@barreto.tech>
;; Maintainer: Daniel Barreto <daniel@barreto.tech>
;; Copyright (C) 2017 Daniel Barreto
;; Created: Thu Nov 16 01:09:49 2017 (+0100)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Stacktrace utilities.
;; Currently, only about rendering stacktrace. More to come.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'parseclj)
(require 'spiral-ast)
(require 'spiral-mode)
(defcustom spiral-stacktrace-print-length 50
"Set the maximum length of frames in displayed trace data.
This sets the value of UNREPL session's `*print-length*` when pretty
printing the `ex-data` map for exception causes in the stacktrace that are
instances of `IExceptionInfo`.
Set to nil for no limit."
:type '(choice integer (const nil))
:group 'spiral)
(defcustom spiral-stacktrace-print-level 50
"Set the maximum level of nesting in displayed cause data.
This sets the value of UNREPL session's `*print-level*` when pretty
printing the `ex-data` map for exception causes in the stacktrace that are
instances of `IExceptionInfo`.
Be advised that setting this to `nil` will cause the attempted printing of
cyclical data structures."
:type '(choice integer (const nil))
:group 'spiral)
(defvar spiral-stacktrace-detail-max nil
"The maximum detail level for causes. When nil, there's no limit.")
(defvar spiral-stacktrace--calm-down-indent
(concat (propertize " "
'font-lock-face 'spiral-font-exception-prompt-face
'rear-nonsticky '(font-lock-face))
" ")
"This is mostly here to temporarily calm down aggressive-indent-mode.")
;; Faces
;; -------------------------------------------------------------------
(defface spiral-font-exception-title-face
'((t (:inherit font-lock-warning-face)))
"Face for an exception's title."
:group 'spiral)
(defface spiral-font-stacktrace-cause-class-face
'((t (:inherit compilation-error)))
"Face for an exception's cause class."
:group 'spiral)
(defface spiral-font-stacktrace-frame-file-face
'((t (:inherit compilation-common-part)))
"Face for a file name in a frame."
:group 'spiral)
(defface spiral-font-stacktrace-frame-lineno-face
'((t (:inherit compilation-mode-line-exit)))
"Face for a line number in a frame."
:group 'spiral)
(defface spiral-font-stacktrace-frame-where-face
'((t (:inherit compilation-info)))
"Face for a fn/class name in a frame."
:group 'spiral)
;; Rendering
;; -------------------------------------------------------------------
(defun spiral-stacktrace--insert-title (phase)
"Insert an exception title for PHASE."
(insert
(propertize
(pcase phase
(:eval "Unhandled Exception")
(:read "UNREPL could not read this input")
(:print "Expression computed successfully but UNREPL failed to print")
(_ (format "Exception during %s phase" (spiral-keyword-name phase))))
'font-lock-face 'spiral-font-exception-title-face))
(spiral-repl-newline-and-scroll))
(declare-function spiral-repl-newline-and-scroll "spiral-repl")
(defun spiral-stacktrace--insert-cause (cause format-spacing)
"Insert a prettified version of an exception CAUSE map.
FORMAT-SPACING is a number of char spaces to be left blank to the left of
the inserted text. For more information, see
`spiral-stacktrace--insert-causes'."
(insert spiral-stacktrace--calm-down-indent)
;; Insert the actual cause
(let ((padded-format (concat "%" (format "%ds: " format-spacing)))
(type (spiral-ast-map-elt cause :type))
(cause-msg (spiral-ast-map-elt cause :message)))
(insert (propertize (format padded-format (spiral-ast-unparse-to-string type))
'font-lock-face 'spiral-font-stacktrace-cause-class-face))
(unless (spiral-ast-nil-p cause-msg)
(spiral-ast-unparse-stdout-string cause-msg))
(spiral-repl-newline-and-scroll)))
(defun spiral-stacktrace--insert-causes (via-node)
"Insert causes for an exception provided by VIA-NODE.
VIA-NODE is an AST node of a vector, as provided by
`clojure.core/Throwable->map's `:via'."
(let* ((causes (parseclj-ast-children via-node))
(cause-type-length (lambda (c)
(thread-first c
(spiral-ast-map-elt :type)
(parseclj-ast-value)
(symbol-name)
(length))))
(longest-type-length (apply #'max (mapcar cause-type-length
causes))))
(mapc (lambda (cause)
(spiral-stacktrace--insert-cause cause
longest-type-length))
(reverse causes))
(spiral-repl-newline-and-scroll)))
(defun spiral-stacktrace--insert-trace (trace-node &optional paddings)
"Insert a pretty representation of TRACE-NODE.
TRACE-NODE is an AST vector node as provided by
`clojure.core/Throwable->map's `:trace'.
PADDINGS is a cons tuple of two numbers, each representing the paddings to
be used for each trace entry's file name and line number"
(let* ((frames (parseclj-ast-children trace-node))
(get-file (lambda (frame)
(thread-first frame
(parseclj-ast-children)
(cl-caddr)
(parseclj-ast-value))))
(get-lineno (lambda (frame)
(thread-first frame
(parseclj-ast-children)
(cl-cadddr)
(parseclj-ast-value))))
(get-where (lambda (frame)
(format "%s/%s"
(parseclj-ast-value (car (parseclj-ast-children frame)))
(parseclj-ast-value (cadr (parseclj-ast-children frame))))))
(get-paddings (lambda (trace-list)
(seq-reduce (lambda (acc te)
(if (eql (parseclj-ast-node-type te) :tag)
acc
(cons (max (car acc) (length (funcall get-file te)))
(max (cdr acc) (length (number-to-string
(funcall get-lineno te)))))))
trace-list
'(0 . 0))))
(paddings (or paddings (funcall get-paddings frames)))
(file-format (format "%%%ds: " (car paddings)))
(lineno-format (format "%%%dd " (cdr paddings))))
(mapc (lambda (frame)
(if (spiral-ast-elision-p frame)
(spiral-ast-elision-tag-unparse
frame nil nil
(lambda (eval-payload &rest _args)
(let ((inhibit-read-only t)
(buffer-read-only nil))
(spiral-stacktrace--insert-trace eval-payload paddings))))
(if (eql (parseclj-ast-node-type frame) :vector) ;; clojure 1.9.0
(insert
spiral-stacktrace--calm-down-indent
(concat
(propertize (format file-format (funcall get-file frame))
'font-lock-face 'spiral-font-stacktrace-frame-file-face)
(propertize (format lineno-format (funcall get-lineno frame))
'font-lock-face 'spiral-font-stacktrace-frame-lineno-face)
(propertize (format "- %s" (funcall get-where frame))
'font-lock-face 'spiral-font-stacktrace-frame-where-face)))
(spiral-ast-unparse frame)) ;; clojure 1.8.0
(spiral-repl-newline-and-scroll)))
frames)))
(defun spiral-stacktrace--insert-trace-button (trace-node)
"Insert a button for displaying a trace with TRACE-NODE."
(spiral-button-throwaway-insert "[Show Trace]"
(lambda (_button)
(spiral-stacktrace--insert-trace trace-node)))
(spiral-repl-newline-and-scroll 2))
(defun spiral-stacktrace-insert-error (error-tag-node &optional show-trace)
"Insert a pretty rendering of an ERROR-TAG-NODE.
This function is deliberately not used as a tag reader in order to be able
to only use it on demand, so that error tags that come from the REPL are
displayed literally by default.
ERROR-TAG-NODE is an AST node. SHOW-TRACE is a boolean flag that indicates
whether to automatically show the error's stack `:trace'. When nil, it's
hidden and a 'Show Trace' button is inserted in its place."
(let* ((ex-data (spiral-ast-tag-child error-tag-node))
(ex-via (spiral-ast-map-elt ex-data :via))
(ex-trace (spiral-ast-map-elt ex-data :trace)))
(spiral-stacktrace--insert-causes ex-via)
(if show-trace
(spiral-stacktrace--insert-trace ex-trace)
(spiral-stacktrace--insert-trace-button ex-trace))))
(defun spiral-stacktrace-insert (ex-message-node &optional show-trace)
"Insert a pretty rendering of EX-MESSAGE-NODE data.
EX-MESSAGE-NODE is an AST node as provided by UNREPL's `:exception'
message.
SHOW-TRACE is a boolean flag that indicates whether to automatically show
the exception stack trace. When nil, it's hidden and a 'Show Trace' button
will be inserted in its place."
(let* ((ex-phase (thread-first ex-message-node
(spiral-ast-map-elt :phase)
(parseclj-ast-value)))
(error-tag (thread-first ex-message-node
(spiral-ast-map-elt :ex))))
(let ((electric-indent-inhibit t))
(spiral-stacktrace--insert-title ex-phase)
(spiral-stacktrace-insert-error error-tag show-trace))))
(defun spiral-stacktrace-popup (conn-id ex-message-node)
"Create a pop to a temporary buffer to show stacktrace in EX-MESSAGE-NODE.
CONN-ID is a connection id to be associated to the error buffer, so that
elisions how to expand.
EX-MESSAGE-NODE is an AST node as provided by UNREPL's `:exception'
message."
(let ((err-buffer-name "*clojure-error*"))
(when (get-buffer err-buffer-name)
(kill-buffer err-buffer-name))
(let ((err-buffer (get-buffer-create err-buffer-name)))
(with-current-buffer err-buffer
(spiral-stacktrace-mode)
(setq-local spiral-conn-id conn-id)
(let ((inhibit-read-only t))
(spiral-stacktrace-insert ex-message-node 'show-trace))
(pop-to-buffer err-buffer)))))
(define-derived-mode spiral-stacktrace-mode special-mode "Stacktrace"
"Major mode for navigating SPIRAL stacktraces.
\\{spiral-stacktrace-mode-map}"
(setq-local electric-indent-chars nil))
(provide 'spiral-stacktrace)
;;; spiral-stacktrace.el ends here