cider-browse-spec.el (19623B)
1 ;;; cider-browse-spec.el --- CIDER spec browser -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2017-2023 Juan Monetta, Bozhidar Batsov and CIDER contributors 4 5 ;; Author: Juan Monetta <jpmonettas@gmail.com> 6 7 ;; This program is free software: you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 ;; This file is not part of GNU Emacs. 21 22 ;;; Commentary: 23 24 ;; M-x cider-browse-spec 25 ;; 26 ;; Display a spec description you can browse. 27 ;; Pressing <enter> over a sub spec will take you to the description of that sub spec. 28 ;; Pressing ^ takes you to the list of all specs. 29 30 ;; M-x cider-browse-spec-all 31 ;; 32 ;; Explore clojure.spec registry by browsing a list of all specs. 33 ;; Pressing <enter> over a spec display the spec description you can browse. 34 35 ;;; Code: 36 37 (require 'cider-client) 38 (require 'cider-popup) 39 (require 'cider-util) 40 (require 'cl-lib) 41 (require 'nrepl-dict) 42 (require 'seq) 43 (require 'subr-x) 44 (require 'help-mode) 45 46 ;; The buffer names used by the spec browser 47 (defconst cider-browse-spec-buffer "*cider-spec-browser*") 48 (defconst cider-browse-spec-example-buffer "*cider-spec-example*") 49 50 ;; Mode Definition 51 52 (defvar cider-browse-spec-mode-map 53 (let ((map (make-sparse-keymap))) 54 (set-keymap-parent map (make-composed-keymap button-buffer-map 55 cider-popup-buffer-mode-map)) 56 (define-key map (kbd "RET") #'cider-browse-spec--browse-at) 57 (define-key map "n" #'forward-button) 58 (define-key map "p" #'backward-button) 59 map) 60 "Keymap for `cider-browse-spec-mode'.") 61 62 (define-derived-mode cider-browse-spec-mode special-mode "Specs" 63 "Major mode for browsing Clojure specs. 64 65 \\{cider-browse-spec-mode-map}" 66 (setq-local electric-indent-chars nil) 67 (setq-local sesman-system 'CIDER) 68 (when cider-special-mode-truncate-lines 69 (setq-local truncate-lines t))) 70 71 (defvar cider-browse-spec--current-spec nil) 72 73 (defvar cider-browse-spec-view-mode-map 74 (let ((map (make-sparse-keymap))) 75 (set-keymap-parent map help-mode-map) 76 (define-key map (kbd "RET") #'cider-browse-spec--browse-at) 77 (define-key map "^" #'cider-browse-spec-all) 78 (define-key map "e" #'cider-browse-spec--print-curr-spec-example) 79 (define-key map "n" #'forward-button) 80 (define-key map "p" #'backward-button) 81 map) 82 "Keymap for `cider-browse-spec-view-mode'.") 83 84 (define-derived-mode cider-browse-spec-view-mode help-mode "Spec" 85 "Major mode for displaying CIDER spec. 86 87 \\{cider-browse-spec-view-mode-map}" 88 (setq-local cider-browse-spec--current-spec nil) 89 (setq-local electric-indent-chars nil) 90 (setq-local sesman-system 'CIDER) 91 (when cider-special-mode-truncate-lines 92 (setq-local truncate-lines t))) 93 94 (defvar cider-browse-spec-example-mode-map 95 (let ((map (make-sparse-keymap))) 96 (set-keymap-parent map cider-popup-buffer-mode-map) 97 (define-key map "^" #'cider-browse-spec-all) 98 (define-key map "e" #'cider-browse-spec--print-curr-spec-example) 99 (define-key map "g" #'revert-buffer) 100 map) 101 "Keymap for `cider-browse-spec-example-mode'.") 102 103 (define-derived-mode cider-browse-spec-example-mode special-mode "Example" 104 "Major mode for Clojure spec examples. 105 106 \\{cider-browse-spec-example-mode-map}" 107 (setq-local electric-indent-chars nil) 108 (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) 109 (setq-local sesman-system 'CIDER) 110 (when cider-special-mode-truncate-lines 111 (setq-local truncate-lines t))) 112 113 ;; Non interactive functions 114 115 (define-button-type 'cider-browse-spec--spec 116 'action #'cider-browse-spec--browse-at 117 'face nil 118 'follow-link t 119 'help-echo "View spec") 120 121 (defun cider-browse-spec--draw-list-buffer (buffer title specs) 122 "Reset contents of BUFFER. 123 Display TITLE at the top and SPECS are indented underneath." 124 (with-current-buffer buffer 125 (cider-browse-spec-mode) 126 (let ((inhibit-read-only t)) 127 (erase-buffer) 128 (goto-char (point-max)) 129 (insert (cider-propertize title 'emph) "\n") 130 (dolist (spec-name specs) 131 (insert (propertize " " 'spec-name spec-name)) 132 (thread-first 133 (cider-font-lock-as-clojure spec-name) 134 (insert-text-button 'type 'cider-browse-spec--spec) 135 (button-put 'spec-name spec-name)) 136 (insert (propertize "\n" 'spec-name spec-name))) 137 (goto-char (point-min))))) 138 139 (defun cider--qualified-keyword-p (str) 140 "Return non nil if STR is a namespaced keyword." 141 (string-match-p "^:.+/.+$" str)) 142 143 (defun cider--spec-fn-p (value fn-name) 144 "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." 145 (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" fn-name "$") value)) 146 147 (defun cider-browse-spec--render-schema-map (spec-form) 148 "Render the s/schema map declaration SPEC-FORM." 149 (let ((name-spec-pairs (seq-partition (cdaadr spec-form) 2))) 150 (format "(s/schema\n {%s})" 151 (string-join 152 (thread-last 153 (seq-sort-by #'car #'string< name-spec-pairs) 154 (mapcar (lambda (s) (concat (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) 155 "\n ")))) 156 157 (defun cider-browse-spec--render-schema-vector (spec-form) 158 "Render the s/schema vector declaration SPEC-FORM." 159 (format "(s/schema\n [%s])" 160 (string-join 161 (thread-last 162 (cl-second spec-form) 163 (mapcar (lambda (s) (cider-browse-spec--pprint s)))) 164 "\n "))) 165 166 (defun cider-browse-spec--render-schema (spec-form) 167 "Render the s/schema SPEC-FORM." 168 (let ((schema-args (cl-second spec-form))) 169 (if (and (listp schema-args) 170 (nrepl-dict-p (cl-first schema-args))) 171 (cider-browse-spec--render-schema-map spec-form) 172 (cider-browse-spec--render-schema-vector spec-form)))) 173 174 (defun cider-browse-spec--render-select (spec-form) 175 "Render the s/select SPEC-FORM." 176 (let ((keyset (cl-second spec-form)) 177 (selection (cl-third spec-form))) 178 (format "(s/select\n %s\n [%s])" 179 (cider-browse-spec--pprint keyset) 180 (string-join 181 (thread-last 182 selection 183 (mapcar (lambda (s) (cider-browse-spec--pprint s)))) 184 "\n ")))) 185 186 (defun cider-browse-spec--render-union (spec-form) 187 "Render the s/union SPEC-FORM." 188 (let ((keyset (cl-second spec-form)) 189 (selection (cl-third spec-form))) 190 (format "(s/union\n %s\n [%s])" 191 (cider-browse-spec--pprint keyset) 192 (string-join 193 (thread-last 194 selection 195 (mapcar (lambda (s) (cider-browse-spec--pprint s)))) 196 "\n ")))) 197 198 (defun cider-browse-spec--render-vector (spec-form) 199 "Render SPEC-FORM as a vector." 200 (format "[%s]" (string-join (mapcar #'cider-browse-spec--pprint spec-form)))) 201 202 (defun cider-browse-spec--render-map-entry (spec-form) 203 "Render SPEC-FORM as a map entry." 204 (let ((key (cl-first spec-form)) 205 (value (cl-second spec-form))) 206 (format "%s %s" (cider-browse-spec--pprint key) 207 (if (listp value) 208 (cider-browse-spec--render-vector value) 209 (cider-browse-spec--pprint value))))) 210 211 (defun cider-browse-spec--render-map (spec-form) 212 "Render SPEC-FORM as a map." 213 (let ((map-entries (cl-rest spec-form))) 214 (format "{%s}" (thread-last 215 (seq-partition map-entries 2) 216 (seq-map #'cider-browse-spec--render-map-entry) 217 (string-join))))) 218 219 (defun cider-browse-spec--pprint (form) 220 "Given a spec FORM builds a multi line string with a pretty render of that FORM." 221 (cond ((stringp form) 222 (if (cider--qualified-keyword-p form) 223 (with-temp-buffer 224 (thread-first 225 form 226 (insert-text-button 'type 'cider-browse-spec--spec) 227 (button-put 'spec-name form)) 228 (buffer-string)) 229 ;; to make it easier to read replace all clojure.spec ns with s/ 230 ;; and remove all clojure.core ns 231 (thread-last 232 form 233 (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" "s/") 234 (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) 235 236 ((and (listp form) (stringp (cl-first form))) 237 (let ((form-tag (cl-first form))) 238 (cond 239 ;; prettier fns #() 240 ((string-equal form-tag "clojure.core/fn") 241 (if (equal (cl-second form) '("%")) 242 (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) 243 (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) 244 ;; prettier (s/and ) 245 ((cider--spec-fn-p form-tag "and") 246 (format "(s/and\n%s)" (string-join (thread-last 247 (cl-rest form) 248 (mapcar #'cider-browse-spec--pprint) 249 (mapcar (lambda (x) (format "%s" x)))) 250 "\n"))) 251 ;; prettier (s/or ) 252 ((cider--spec-fn-p form-tag "or") 253 (let ((name-spec-pair (seq-partition (cl-rest form) 2))) 254 (format "(s/or\n%s)" (string-join 255 (thread-last 256 name-spec-pair 257 (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) 258 "\n")))) 259 ;; prettier (s/merge ) 260 ((cider--spec-fn-p form-tag "merge") 261 (format "(s/merge\n%s)" (string-join (thread-last 262 (cl-rest form) 263 (mapcar #'cider-browse-spec--pprint) 264 (mapcar (lambda (x) (format "%s" x)))) 265 "\n"))) 266 ;; prettier (s/keys ) 267 ((cider--spec-fn-p form-tag "keys") 268 (let ((keys-args (seq-partition (cl-rest form) 2))) 269 (format "(s/keys%s)" (thread-last 270 keys-args 271 (mapcar (lambda (s) 272 (let ((key-type (cl-first s)) 273 (specs-vec (cl-second s))) 274 (concat "\n" key-type 275 " [" 276 (string-join (thread-last 277 specs-vec 278 (mapcar #'cider-browse-spec--pprint) 279 (mapcar (lambda (x) (format "%s" x)))) 280 "\n") 281 "]")))) 282 (cl-reduce #'concat))))) 283 ;; prettier (s/multi-spec) 284 ((cider--spec-fn-p form-tag "multi-spec") 285 (let ((multi-method (cl-second form)) 286 (retag (cl-third form)) 287 (sub-specs (cl-rest (cl-rest (cl-rest form))))) 288 (format "(s/multi-spec %s %s\n%s)" 289 multi-method 290 retag 291 (string-join 292 (thread-last 293 sub-specs 294 (mapcar (lambda (s) 295 (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) 296 "\n")))) 297 ;; prettier (s/cat ) 298 ((cider--spec-fn-p form-tag "cat") 299 (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) 300 (format "(s/cat %s)" 301 (thread-last 302 name-spec-pairs 303 (mapcar (lambda (s) 304 (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) 305 (cl-reduce #'concat))))) 306 ;; prettier (s/alt ) 307 ((cider--spec-fn-p form-tag "alt") 308 (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) 309 (format "(s/alt %s)" 310 (thread-last 311 name-spec-pairs 312 (mapcar (lambda (s) 313 (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) 314 (cl-reduce #'concat))))) 315 ;; prettier (s/fspec ) 316 ((cider--spec-fn-p form-tag "fspec") 317 (thread-last 318 (seq-partition (cl-rest form) 2) 319 (cl-remove-if (lambda (s) (and (stringp (cl-second s)) 320 (string-empty-p (cl-second s))))) 321 (mapcar (lambda (s) 322 (format "\n%-11s: %s" (pcase (cl-first s) 323 (":args" "arguments") 324 (":ret" "returns") 325 (":fn" "invariants")) 326 (cider-browse-spec--pprint (cl-second s))))) 327 (cl-reduce #'concat) 328 (format "%s"))) 329 ;; prettier (s/schema ) 330 ((cider--spec-fn-p form-tag "schema") 331 (cider-browse-spec--render-schema form)) 332 ;; prettier (s/select ) 333 ((cider--spec-fn-p form-tag "select") 334 (cider-browse-spec--render-select form)) 335 ;; prettier (s/union ) 336 ((cider--spec-fn-p form-tag "union") 337 (cider-browse-spec--render-union form)) 338 ;; every other with no special management 339 (t (format "(%s %s)" 340 (cider-browse-spec--pprint form-tag) 341 (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) 342 ((nrepl-dict-p form) 343 (cider-browse-spec--render-map form)) 344 (t (format "%s" form)))) 345 346 (defun cider-browse-spec--pprint-indented (spec-form) 347 "Indent (pretty-print) and font-lock SPEC-FORM. 348 Return the result as a string." 349 (with-temp-buffer 350 (clojure-mode) 351 (insert (cider-browse-spec--pprint spec-form)) 352 (indent-region (point-min) (point-max)) 353 (font-lock-ensure) 354 (buffer-string))) 355 356 (defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) 357 "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. 358 Display SPEC as a title and uses `cider-browse-spec--pprint' to display 359 a more user friendly representation of SPEC-FORM." 360 (with-current-buffer buffer 361 (let ((inhibit-read-only t)) 362 (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) 363 (goto-char (point-max)) 364 (insert (cider-font-lock-as-clojure spec) "\n\n") 365 (insert (cider-browse-spec--pprint-indented spec-form)) 366 (cider--make-back-forward-xrefs) 367 (current-buffer)))) 368 369 (defun cider-browse-spec--browse (spec) 370 "Browse SPEC." 371 (cider-ensure-connected) 372 (cider-ensure-op-supported "spec-form") 373 ;; Expand auto-resolved keywords 374 (when-let* ((val (and (string-match-p "^::.+" spec) 375 (nrepl-dict-get (cider-sync-tooling-eval spec (cider-current-ns)) "value")))) 376 (setq spec val)) 377 (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) 378 (setq-local cider-browse-spec--current-spec spec) 379 (cider-browse-spec--draw-spec-buffer (current-buffer) 380 spec 381 (cider-sync-request:spec-form spec)) 382 (goto-char (point-min)) 383 (current-buffer))) 384 385 (defun cider-browse-spec--browse-at (&optional pos) 386 "View the definition of a spec. 387 388 Optional argument POS is the position of a spec, defaulting to point. POS 389 may also be a button, so this function can be used a the button's `action' 390 property." 391 (interactive) 392 (let ((pos (or pos (point)))) 393 (when-let* ((spec (button-get pos 'spec-name))) 394 (cider-browse-spec--browse spec)))) 395 396 ;; Interactive Functions 397 398 (defun cider-browse-spec--print-curr-spec-example () 399 "Generate and print an example of the current spec." 400 (interactive) 401 (cider-ensure-connected) 402 (cider-ensure-op-supported "spec-example") 403 (if-let* ((spec cider-browse-spec--current-spec)) 404 (if-let* ((example (cider-sync-request:spec-example spec))) 405 (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) 406 (setq-local cider-browse-spec--current-spec spec) 407 (let ((inhibit-read-only t)) 408 (insert "Example of " (cider-font-lock-as-clojure spec)) 409 (insert "\n\n") 410 (insert (cider-font-lock-as-clojure example)) 411 (goto-char (point-min)))) 412 (error (format "No example for spec %s" spec))) 413 (error "No current spec"))) 414 415 (defun cider-browse-spec--example-revert-buffer-function (&rest _) 416 "`revert-buffer' function for `cider-browse-spec-example-mode'. 417 418 Generates a new example for the current spec." 419 (cider-browse-spec--print-curr-spec-example)) 420 421 ;;;###autoload 422 (defun cider-browse-spec (spec) 423 "Browse SPEC definition." 424 (interactive (list (completing-read "Browse spec: " 425 (cider-sync-request:spec-list) 426 nil nil 427 (cider-symbol-at-point)))) 428 (cider-browse-spec--browse spec)) 429 430 (defun cider-browse-spec-regex (regex) 431 "Open the list of specs that matches REGEX in a popup buffer. 432 Displays all specs when REGEX is nil." 433 (cider-ensure-connected) 434 (cider-ensure-op-supported "spec-list") 435 (let ((filter-regex (or regex ""))) 436 (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) 437 (let ((specs (cider-sync-request:spec-list filter-regex))) 438 (cider-browse-spec--draw-list-buffer (current-buffer) 439 (if (string-empty-p filter-regex) 440 "All specs in registry" 441 (format "All specs matching regex `%s' in registry" filter-regex)) 442 specs))))) 443 444 ;;;###autoload 445 (defun cider-browse-spec-all (&optional arg) 446 "Open list of specs in a popup buffer. 447 448 With a prefix argument ARG, prompts for a regexp to filter specs. 449 No filter applied if the regexp is the empty string." 450 (interactive "P") 451 (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) 452 453 (provide 'cider-browse-spec) 454 455 ;;; cider-browse-spec.el ends here