cider-profile.el (8057B)
1 ;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2014-2023 Edwin Watkeys and CIDER contributors 4 5 ;; Author: Edwin Watkeys <edw@poseur.com> 6 ;; Juan E. Maya <jmayaalv@gmail.com> 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 23 ;; Provides coarse-grained interactive profiling support. 24 ;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). 25 26 ;;; Code: 27 28 (require 'cider-client) 29 (require 'cider-popup) 30 (require 'cider-eval) 31 32 (defconst cider-profile-buffer "*cider-profile*") 33 34 (defvar cider-profile-map 35 (let ((map (define-prefix-command 'cider-profile-map))) 36 (define-key map (kbd "t") #'cider-profile-toggle) 37 (define-key map (kbd "C-t") #'cider-profile-toggle) 38 (define-key map (kbd "c") #'cider-profile-clear) 39 (define-key map (kbd "C-c") #'cider-profile-clear) 40 (define-key map (kbd "S") #'cider-profile-summary) 41 (define-key map (kbd "C-S") #'cider-profile-summary) 42 (define-key map (kbd "s") #'cider-profile-var-summary) 43 (define-key map (kbd "C-s") #'cider-profile-var-summary) 44 (define-key map (kbd "n") #'cider-profile-ns-toggle) 45 (define-key map (kbd "C-n") #'cider-profile-ns-toggle) 46 (define-key map (kbd "v") #'cider-profile-var-profiled-p) 47 (define-key map (kbd "C-v") #'cider-profile-var-profiled-p) 48 (define-key map (kbd "+") #'cider-profile-samples) 49 (define-key map (kbd "C-+") #'cider-profile-samples) 50 map) 51 "CIDER profiler keymap.") 52 53 (defconst cider-profile-menu 54 '("Profile" 55 ["Toggle var profiling" cider-profile-toggle] 56 ["Toggle namespace profiling" cider-profile-ns-toggle] 57 "--" 58 ["Display var profiling status" cider-profile-var-profiled-p] 59 ["Display max sample count" cider-profile-samples] 60 ["Display var summary" cider-profile-var-summary] 61 ["Display summary" cider-profile-summary] 62 ["Clear data" cider-profile-clear]) 63 "CIDER profiling submenu.") 64 65 (defun cider-profile--make-response-handler (handler &optional buffer) 66 "Make a response handler using value handler HANDLER for connection BUFFER. 67 68 Optional argument BUFFER defaults to current buffer." 69 (nrepl-make-response-handler 70 (or buffer (current-buffer)) handler nil nil nil)) 71 72 ;;;###autoload 73 (defun cider-profile-samples (&optional query) 74 "Displays current max-sample-count. 75 If optional QUERY is specified, set max-sample-count and display new value." 76 (interactive "P") 77 (cider-ensure-op-supported "set-max-samples") 78 (cider-ensure-op-supported "get-max-samples") 79 (if (not (null query)) 80 (cider-nrepl-send-request 81 (let ((max-samples (if (numberp query) query '()))) 82 (message "query: %s" max-samples) 83 `("op" "set-max-samples" "max-samples" ,max-samples)) 84 (cider-profile--make-response-handler 85 (lambda (_buffer value) 86 (let ((value (if (zerop (length value)) "unlimited" value))) 87 (message "max-sample-count is now %s" value))))) 88 (cider-nrepl-send-request 89 '("op" "get-max-samples") 90 (cider-profile--make-response-handler 91 (lambda (_buffer value) 92 (let ((value (if (zerop (length value)) "unlimited" value))) 93 (message "max-sample-count is now %s" value)))))) 94 query) 95 96 ;;;###autoload 97 (defun cider-profile-var-profiled-p (query) 98 "Displays the profiling status of var under point. 99 Prompts for var if none under point or QUERY is present." 100 (interactive "P") 101 (cider-ensure-op-supported "is-var-profiled") 102 (cider-read-symbol-name 103 "Report profiling status for var: " 104 (lambda (sym) 105 (let ((ns (cider-current-ns))) 106 (cider-nrepl-send-request 107 `("op" "is-var-profiled" 108 "ns" ,ns 109 "sym" ,sym) 110 (cider-profile--make-response-handler 111 (lambda (_buffer value) 112 (pcase value 113 ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) 114 ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) 115 ("unbound" (message "%s/%s is unbound" ns sym))))))))) 116 query) 117 118 ;;;###autoload 119 (defun cider-profile-ns-toggle (&optional query) 120 "Toggle profiling for the ns associated with optional QUERY. 121 122 If optional argument QUERY is non-nil, prompt for ns. Otherwise use 123 current ns." 124 (interactive "P") 125 (cider-ensure-op-supported "toggle-profile-ns") 126 (let ((ns (if query 127 (completing-read "Toggle profiling for ns: " 128 (cider-sync-request:ns-list)) 129 (cider-current-ns)))) 130 (cider-nrepl-send-request 131 `("op" "toggle-profile-ns" 132 "ns" ,ns) 133 (cider-profile--make-response-handler 134 (lambda (_buffer value) 135 (pcase value 136 ("profiled" (message "Profiling enabled for %s" ns)) 137 ("unprofiled" (message "Profiling disabled for %s" ns))))))) 138 query) 139 140 ;;;###autoload 141 (defun cider-profile-toggle (query) 142 "Toggle profiling for the given QUERY. 143 Defaults to the symbol at point. 144 With prefix arg or no symbol at point, prompts for a var." 145 (interactive "P") 146 (cider-ensure-op-supported "toggle-profile") 147 (cider-read-symbol-name 148 "Toggle profiling for var: " 149 (lambda (sym) 150 (let ((ns (cider-current-ns))) 151 (cider-nrepl-send-request 152 `("op" "toggle-profile" 153 "ns" ,ns 154 "sym" ,sym) 155 (cider-profile--make-response-handler 156 (lambda (_buffer value) 157 (pcase value 158 ("profiled" (message "Profiling enabled for %s/%s" ns sym)) 159 ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) 160 ("unbound" (message "%s/%s is unbound" ns sym))))))))) 161 query) 162 163 (defun cider-profile-display-stats (stats-response) 164 "Displays the STATS-RESPONSE on `cider-profile-buffer`." 165 (let ((table (nrepl-dict-get stats-response "err"))) 166 (if cider-profile-buffer 167 (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) 168 (with-current-buffer buffer 169 (let ((inhibit-read-only t)) (insert table))) 170 (display-buffer buffer) 171 (let ((window (get-buffer-window buffer))) 172 (set-window-point window 0) 173 (select-window window) 174 (fit-window-to-buffer window))) 175 (cider-emit-interactive-eval-err-output table)))) 176 177 ;;;###autoload 178 (defun cider-profile-summary () 179 "Display a summary of currently collected profile data." 180 (interactive) 181 (cider-ensure-op-supported "profile-summary") 182 (cider-profile-display-stats 183 (cider-nrepl-send-sync-request '("op" "profile-summary")))) 184 185 ;;;###autoload 186 (defun cider-profile-var-summary (query) 187 "Display profile data for var under point QUERY. 188 Defaults to the symbol at point. With prefix arg or no symbol at point, 189 prompts for a var." 190 (interactive "P") 191 (cider-ensure-op-supported "profile-var-summary") 192 (cider-read-symbol-name 193 "Profile-summary for var: " 194 (lambda (sym) 195 (cider-profile-display-stats 196 (cider-nrepl-send-sync-request 197 `("op" "profile-var-summary" 198 "ns" ,(cider-current-ns) 199 "sym" ,sym))))) 200 query) 201 202 ;;;###autoload 203 (defun cider-profile-clear () 204 "Clear any collected profile data." 205 (interactive) 206 (cider-ensure-op-supported "clear-profile") 207 (cider-nrepl-send-request 208 '("op" "clear-profile") 209 (cider-profile--make-response-handler 210 (lambda (_buffer value) 211 (when (equal value "cleared") 212 (message "Cleared profile data")))))) 213 214 (provide 'cider-profile) 215 216 ;;; cider-profile.el ends here