blob: d58352b16896c4cb8fcaab3cb5e36e170e396b02 (
plain) (
tree)
|
|
;;; cider-browse-spec.el --- CIDER spec browser
;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors
;; Author: Juan Monetta <jpmonettas@gmail.com>
;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; M-x cider-browse-spec
;;
;; Display a spec description you can browse.
;; Pressing <enter> over a sub spec will take you to the description of that sub spec.
;; Pressing ^ takes you to the list of all specs.
;; M-x cider-browse-spec-all
;;
;; Explore clojure.spec registry by browsing a list of all specs.
;; Pressing <enter> over a spec display the spec description you can browse.
;;; Code:
(require 'cider-client)
(require 'cider-compat)
(require 'cider-util)
(require 'cl-lib)
(require 'nrepl-dict)
(require 'seq)
(require 'subr-x)
(require 'help-mode)
;; The buffer names used by the spec browser
(defconst cider-browse-spec-buffer "*cider-spec-browser*")
(defconst cider-browse-spec-example-buffer "*cider-spec-example*")
;; Mode Definition
(defvar cider-browse-spec-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap button-buffer-map
cider-popup-buffer-mode-map))
(define-key map (kbd "RET") #'cider-browse-spec--browse-at)
(define-key map "n" #'forward-button)
(define-key map "p" #'backward-button)
map)
"Keymap for `cider-browse-spec-mode'.")
(define-derived-mode cider-browse-spec-mode special-mode "Specs"
"Major mode for browsing Clojure specs.
\\{cider-browse-spec-mode-map}"
(setq-local electric-indent-chars nil)
(setq-local sesman-system 'CIDER)
(when cider-special-mode-truncate-lines
(setq-local truncate-lines t)))
(defvar cider-browse-spec--current-spec nil)
(defvar cider-browse-spec-view-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map help-mode-map)
(define-key map (kbd "RET") #'cider-browse-spec--browse-at)
(define-key map "^" #'cider-browse-spec-all)
(define-key map "e" #'cider-browse-spec--print-curr-spec-example)
(define-key map "n" #'forward-button)
(define-key map "p" #'backward-button)
map)
"Keymap for `cider-browse-spec-view-mode'.")
(define-derived-mode cider-browse-spec-view-mode help-mode "Spec"
"Major mode for displaying CIDER spec.
\\{cider-browse-spec-view-mode-map}"
(setq-local cider-browse-spec--current-spec nil)
(setq-local electric-indent-chars nil)
(setq-local sesman-system 'CIDER)
(when cider-special-mode-truncate-lines
(setq-local truncate-lines t)))
(defvar cider-browse-spec-example-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map "^" #'cider-browse-spec-all)
(define-key map "e" #'cider-browse-spec--print-curr-spec-example)
(define-key map "g" #'revert-buffer)
map)
"Keymap for `cider-browse-spec-example-mode'.")
(define-derived-mode cider-browse-spec-example-mode special-mode "Example"
"Major mode for Clojure spec examples.
\\{cider-browse-spec-example-mode-map}"
(setq-local electric-indent-chars nil)
(setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function)
(setq-local sesman-system 'CIDER)
(when cider-special-mode-truncate-lines
(setq-local truncate-lines t)))
;; Non interactive functions
(define-button-type 'cider-browse-spec--spec
'action #'cider-browse-spec--browse-at
'face nil
'follow-link t
'help-echo "View spec")
(defun cider-browse-spec--draw-list-buffer (buffer title specs)
"Reset contents of BUFFER.
Display TITLE at the top and SPECS are indented underneath."
(with-current-buffer buffer
(cider-browse-spec-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(goto-char (point-max))
(insert (cider-propertize title 'emph) "\n")
(dolist (spec-name specs)
(insert (propertize " " 'spec-name spec-name))
(thread-first (cider-font-lock-as-clojure spec-name)
(insert-text-button 'type 'cider-browse-spec--spec)
(button-put 'spec-name spec-name))
(insert (propertize "\n" 'spec-name spec-name)))
(goto-char (point-min)))))
(defun cider--qualified-keyword-p (str)
"Return non nil if STR is a namespaced keyword."
(string-match-p "^:.+/.+$" str))
(defun cider--spec-fn-p (value fn-name)
"Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME."
(string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value))
(defun cider-browse-spec--pprint (form)
"Given a spec FORM builds a multi line string with a pretty render of that FORM."
(cond ((stringp form)
(if (cider--qualified-keyword-p form)
(with-temp-buffer
(thread-first form
(insert-text-button 'type 'cider-browse-spec--spec)
(button-put 'spec-name form))
(buffer-string))
;; to make it easier to read replace all clojure.spec ns with s/
;; and remove all clojure.core ns
(thread-last form
(replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/")
(replace-regexp-in-string "^\\(clojure.core\\)/" ""))))
((and (listp form) (stringp (cl-first form)))
(let ((form-tag (cl-first form)))
(cond
;; prettier fns #()
((string-equal form-tag "clojure.core/fn")
(if (equal (cl-second form) '("%"))
(format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form)))))
(format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form)))))))
;; prettier (s/and )
((cider--spec-fn-p form-tag "and")
(format "(s/and\n%s)" (string-join (thread-last (cl-rest form)
(mapcar #'cider-browse-spec--pprint)
(mapcar (lambda (x) (format "%s" x))))
"\n")))
;; prettier (s/or )
((cider--spec-fn-p form-tag "or")
(let ((name-spec-pair (seq-partition (cl-rest form) 2)))
(format "(s/or\n%s)" (string-join
(thread-last name-spec-pair
(mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s))))))
"\n"))))
;; prettier (s/merge )
((cider--spec-fn-p form-tag "merge")
(format "(s/merge\n%s)" (string-join (thread-last (cl-rest form)
(mapcar #'cider-browse-spec--pprint)
(mapcar (lambda (x) (format "%s" x))))
"\n")))
;; prettier (s/keys )
((cider--spec-fn-p form-tag "keys")
(let ((keys-args (seq-partition (cl-rest form) 2)))
(format "(s/keys%s)" (thread-last
keys-args
(mapcar (lambda (s)
(let ((key-type (cl-first s))
(specs-vec (cl-second s)))
(concat "\n" key-type
" ["
(string-join (thread-last specs-vec
(mapcar #'cider-browse-spec--pprint)
(mapcar (lambda (x) (format "%s" x))))
"\n")
"]"))))
(cl-reduce #'concat)))))
;; prettier (s/multi-spec)
((cider--spec-fn-p form-tag "multi-spec")
(let ((multi-method (cl-second form))
(retag (cl-third form))
(sub-specs (cl-rest (cl-rest (cl-rest form)))))
(format "(s/multi-spec %s %s\n%s)"
multi-method
retag
(string-join
(thread-last sub-specs
(mapcar (lambda (s)
(concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))))
"\n"))))
;; prettier (s/cat )
((cider--spec-fn-p form-tag "cat")
(let ((name-spec-pairs (seq-partition (cl-rest form) 2)))
(format "(s/cat %s)"
(thread-last name-spec-pairs
(mapcar (lambda (s)
(concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))
(cl-reduce #'concat)))))
;; prettier (s/alt )
((cider--spec-fn-p form-tag "alt")
(let ((name-spec-pairs (seq-partition (cl-rest form) 2)))
(format "(s/alt %s)"
(thread-last name-spec-pairs
(mapcar (lambda (s)
(concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))
(cl-reduce #'concat)))))
;; prettier (s/fspec )
((cider--spec-fn-p form-tag "fspec")
(thread-last (seq-partition (cl-rest form) 2)
(cl-remove-if (lambda (s) (and (stringp (cl-second s))
(string-empty-p (cl-second s)))))
(mapcar (lambda (s)
(format "\n%-11s: %s" (pcase (cl-first s)
(":args" "arguments")
(":ret" "returns")
(":fn" "invariants"))
(cider-browse-spec--pprint (cl-second s)))))
(cl-reduce #'concat)
(format "%s")))
;; every other with no special management
(t (format "(%s %s)"
(cider-browse-spec--pprint form-tag)
(string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " "))))))
(t (format "%s" form))))
(defun cider-browse-spec--pprint-indented (spec-form)
"Indent (pretty-print) and font-lock SPEC-FORM.
Return the result as a string."
(with-temp-buffer
(clojure-mode)
(insert (cider-browse-spec--pprint spec-form))
(indent-region (point-min) (point-max))
(cider--font-lock-ensure)
(buffer-string)))
(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form)
"Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM.
Display SPEC as a title and uses `cider-browse-spec--pprint' to display
a more user friendly representation of SPEC-FORM."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer)
(goto-char (point-max))
(insert (cider-font-lock-as-clojure spec) "\n\n")
(insert (cider-browse-spec--pprint-indented spec-form))
(cider--make-back-forward-xrefs)
(current-buffer))))
(defun cider-browse-spec--browse (spec)
"Browse SPEC."
(cider-ensure-connected)
(cider-ensure-op-supported "spec-form")
(with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary)
(setq-local cider-browse-spec--current-spec spec)
(cider-browse-spec--draw-spec-buffer (current-buffer)
spec
(cider-sync-request:spec-form spec))
(goto-char (point-min))
(current-buffer)))
(defun cider-browse-spec--browse-at (&optional pos)
"View the definition of a spec.
Optional argument POS is the position of a spec, defaulting to point. POS
may also be a button, so this function can be used a the button's `action'
property."
(interactive)
(let ((pos (or pos (point))))
(when-let* ((spec (button-get pos 'spec-name)))
(cider-browse-spec--browse spec))))
;; Interactive Functions
(defun cider-browse-spec--print-curr-spec-example ()
"Generate and print an example of the current spec."
(interactive)
(cider-ensure-connected)
(cider-ensure-op-supported "spec-example")
(if-let* ((spec cider-browse-spec--current-spec))
(if-let* ((example (cider-sync-request:spec-example spec)))
(with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary)
(setq-local cider-browse-spec--current-spec spec)
(let ((inhibit-read-only t))
(insert "Example of " (cider-font-lock-as-clojure spec))
(insert "\n\n")
(insert (cider-font-lock-as-clojure example))
(goto-char (point-min))))
(error (format "No example for spec %s" spec)))
(error "No current spec")))
(defun cider-browse-spec--example-revert-buffer-function (&rest _)
"`revert-buffer' function for `cider-browse-spec-example-mode'.
Generates a new example for the current spec."
(cider-browse-spec--print-curr-spec-example))
;;;###autoload
(defun cider-browse-spec (spec)
"Browse SPEC definition."
(interactive (list (completing-read "Browse spec: "
(cider-sync-request:spec-list)
nil nil
(cider-symbol-at-point))))
(cider-browse-spec--browse spec))
(defun cider-browse-spec-regex (regex)
"Open the list of specs that matches REGEX in a popup buffer.
Displays all specs when REGEX is nil."
(cider-ensure-connected)
(cider-ensure-op-supported "spec-list")
(let ((filter-regex (or regex "")))
(with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary)
(let ((specs (cider-sync-request:spec-list filter-regex)))
(cider-browse-spec--draw-list-buffer (current-buffer)
(if (string-empty-p filter-regex)
"All specs in registry"
(format "All specs matching regex `%s' in registry" filter-regex))
specs)))))
;;;###autoload
(defun cider-browse-spec-all (&optional arg)
"Open list of specs in a popup buffer.
With a prefix argument ARG, prompts for a regexp to filter specs.
No filter applied if the regexp is the empty string."
(interactive "P")
(cider-browse-spec-regex (if arg (read-string "Filter regex: ") "")))
(provide 'cider-browse-spec)
;;; cider-browse-spec.el ends here
|
