Move output to lsp-dart-test-output

Author: ericdallo

lsp-dart-test-output.el

@@ -0,0 +1,182 @@
+;;; lsp-dart-test-output.el --- Test output features and decorations -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2020 Eric Dallo
+;;
+;; 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 <https://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;;  Test output features and decorations
+;;
+;;; Code:
+
+
+(require 'rx)
+
+(require 'lsp-dart-protocol)
+(require 'lsp-dart-utils)
+
+(defcustom lsp-dart-test-pop-to-buffer-on-run 'display-only
+  "Controls whether to pop to the tests buffer on run.
+
+When set to nil the buffer will only be created, and not displayed.
+When set to `display-only' the buffer will be displayed, but it will
+not become focused, otherwise the buffer is displayed and focused."
+  :group 'lsp-dart
+  :type '(choice (const :tag "Create the buffer, but don't display it" nil)
+                 (const :tag "Create and display the buffer, but don't focus it" display-only)
+                 (const :tag "Create, display, and focus the buffer" t)))
+
+
+;;; Internal
+
+(defconst lsp-dart-test-output--passed-icon "★")
+(defconst lsp-dart-test-output--success-icon "✔")
+(defconst lsp-dart-test-output--skipped-icon "•")
+(defconst lsp-dart-test-output--error-icon "✖")
+
+(defvar lsp-dart-test-output--tests-count 0)
+(defvar lsp-dart-test-output--tests-passed 0)
+
+(defconst lsp-dart-test-output--buffer-name "*LSP Dart tests*")
+
+(defconst lsp-dart-test-output--exception-re
+  (rx (or (and (zero-or-more any)
+               (or "exception" "EXCEPTION")
+               (zero-or-more any))
+          "<asynchronous suspension>"
+          (and "#"
+               (one-or-more
+                any)))))
+
+(defconst lsp-dart-test-output--expected-actual-re
+  (rx (or (and (zero-or-more blank)
+               "Expected:"
+               (zero-or-more any))
+          (and (zero-or-more blank)
+               "Actual:"
+               (zero-or-more any)))))
+
+(defconst lsp-dart-test--font-lock
+  `((,lsp-dart-test-output--exception-re . 'error)
+    (,lsp-dart-test-output--expected-actual-re . 'warning)))
+
+(defvar lsp-dart-test--output-font-lock
+  '((lsp-dart-test--font-lock)))
+
+(lsp-defun lsp-dart-test-output--get-icon ((&TestDoneNotification :result :skipped))
+  "Return the icon for test done notification."
+  (if (string= result "success")
+      (if skipped
+          lsp-dart-test-output--skipped-icon
+        lsp-dart-test-output--success-icon)
+    lsp-dart-test-output--error-icon))
+
+(lsp-defun lsp-dart-test-output--get-face ((&TestDoneNotification :result :skipped))
+  "Return the icon for test done notification."
+  (if (string= result "success")
+      (if skipped
+          'homoglyph
+        'success)
+    'error))
+
+(defun lsp-dart-test-output--send (message &rest args)
+  "Send MESSAGE with ARGS to test buffer."
+  (let* ((inhibit-read-only t))
+    (with-current-buffer (lsp-dart-test-output--get-buffer-create)
+      (save-excursion
+        (goto-char (point-max))
+        (insert (apply #'format (concat message "\n") args))))))
+
+(defun lsp-dart-test-output--get-buffer-create ()
+  "Create a buffer for test display."
+  (let ((buffer (get-buffer-create lsp-dart-test-output--buffer-name)))
+    (with-current-buffer buffer
+      (setq-local default-directory (or (lsp-dart-get-project-root) default-directory))
+      (unless (derived-mode-p 'lsp-dart-test-output-content-mode)
+        (lsp-dart-test-output-content-mode))
+      (current-buffer))))
+
+(defun lsp-dart-test-output--show-buffer ()
+  "Show test buffer."
+  (let ((test-buffer (lsp-dart-test-output--get-buffer-create))
+        (inhibit-read-only t))
+    (with-current-buffer test-buffer
+      (erase-buffer))
+    (pcase lsp-dart-test-pop-to-buffer-on-run
+      (`display-only
+       (let ((orig-buffer (current-buffer)))
+         (display-buffer test-buffer)
+         (set-buffer orig-buffer)))
+      ((pred identity) (pop-to-buffer test-buffer)))))
+
+(defun lsp-dart-test-output--handle-run-started ()
+  "Handle test run started."
+  (lsp-dart-test-output--send "Running tests...\n")
+  (lsp-dart-test-output--show-buffer))
+
+(defun lsp-dart-test-output--handle-all-start (_notification)
+  "Handle all start notification."
+  (setq lsp-dart-test-output--tests-count 0)
+  (setq lsp-dart-test-output--tests-passed 0))
+
+(lsp-defun lsp-dart-test-output--handle-start ((&TestStartNotification :test (&Test :group-i-ds)))
+  (unless (seq-empty-p group-i-ds)
+    (setq lsp-dart-test-output--tests-count (1+ lsp-dart-test-output--tests-count))))
+
+(lsp-defun lsp-dart-test-output--handle-done ((notification &as &TestDoneNotification :result :time :hidden) test-name test-start-time)
+  "Handle test done notification."
+  (unless hidden
+    (when (string= result "success")
+      (setq lsp-dart-test-output--tests-passed (1+ lsp-dart-test-output--tests-passed))))
+  (let* ((formatted-time (propertize (format "(%s ms)"
+                                             (- time test-start-time))
+                                     'font-lock-face 'font-lock-comment-face))
+         (text (propertize (concat (lsp-dart-test-output--get-icon notification)
+                                   " "
+                                   test-name)
+                           'font-lock-face (lsp-dart-test-output--get-face notification))))
+    (lsp-dart-test-output--send "%s %s" text formatted-time)))
+
+(lsp-defun lsp-dart-test-output--handle-all-done ((&DoneNotification :success))
+  "Handle all tests done notification."
+  (if success
+      (lsp-dart-test-output--send (propertize (format "\n%s All ran tests passed %s" lsp-dart-test-output--passed-icon lsp-dart-test-output--passed-icon)
+                                              'font-lock-face 'success))
+    (lsp-dart-test-output--send (propertize (format "\n● %s/%s tests passed" lsp-dart-test-output--tests-passed lsp-dart-test-output--tests-count)
+                                            'font-lock-face font-lock-warning-face))))
+
+(lsp-defun lsp-dart-test-output--handle-print ((&PrintNotification :message))
+  "Handle test print notification."
+  (lsp-dart-test-output--send "%s" message))
+
+(lsp-defun lsp-dart-test-output--handle-error ((&ErrorNotification :error :stack-trace))
+  "Handle test error notification."
+  (lsp-dart-test-output--send "%s" error)
+  (lsp-dart-test-output--send "%s" stack-trace))
+
+(define-derived-mode lsp-dart-test-output-content-mode special-mode lsp-dart-test-output--buffer-name
+  "Major mode for buffer running tests."
+  (setq font-lock-defaults lsp-dart-test--output-font-lock))
+
+(add-hook 'lsp-dart-test-run-started-hook #'lsp-dart-test-output--handle-run-started)
+(add-hook 'lsp-dart-test-all-start-notification-hook #'lsp-dart-test-output--handle-all-start)
+(add-hook 'lsp-dart-test-start-notification-hook #'lsp-dart-test-output--handle-start)
+(add-hook 'lsp-dart-test-done-notification-hook #'lsp-dart-test-output--handle-done)
+(add-hook 'lsp-dart-test-all-done-notification-hook #'lsp-dart-test-output--handle-all-done)
+(add-hook 'lsp-dart-test-print-notification-hook #'lsp-dart-test-output--handle-print)
+(add-hook 'lsp-dart-test-error-notification-hook #'lsp-dart-test-output--handle-error)
+
+(provide 'lsp-dart-test-output)
+;;; lsp-dart-test-output.el ends here