home

My NixOS systems configurations.
Log | Files | Refs | LICENSE

gotest-ui.el (24188B)


      1 ;;; gotest-ui.el --- Major mode for running go test -json
      2 
      3 ;; Copyright 2018 Andreas Fuchs
      4 ;; Authors: Andreas Fuchs <asf@boinkor.net>
      5 
      6 ;; URL: https://github.com/antifuchs/gotest-ui-mode
      7 ;; Created: Feb 18, 2018
      8 ;; Keywords: languages go
      9 ;; Version: 0.1.0
     10 ;; Package-Requires: ((emacs "25") (s "1.12.0") (gotest "0.14.0"))
     11 
     12 ;; This file is not a part of GNU Emacs.
     13 
     14 ;; This program is free software; you can redistribute it and/or
     15 ;; modify it under the terms of the GNU General Public License as
     16 ;; published by the Free Software Foundation; either version 3.0, or
     17 ;; (at your option) any later version.
     18 
     19 ;; This program is distributed in the hope that it will be useful,
     20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     22 ;; GNU General Public License for more details.
     23 
     24 ;; You should have received a copy of the GNU General Public License
     25 ;; along with this program; if not, write to the Free Software
     26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     27 
     28 ;;; Commentary:
     29 
     30 ;;  Provides support for running go tests with a nice user interface
     31 ;;  that allows folding away output, highlighting failing tests.
     32 
     33 ;;; Code:
     34 
     35 (eval-when-compile
     36   (require 'cl))
     37 
     38 (require 'subr-x)
     39 (require 'ewoc)
     40 (require 'json)
     41 (require 'compile)
     42 
     43 (defgroup gotest-ui nil
     44   "The go test runner."
     45   :group 'tools)
     46 
     47 (defface gotest-ui-pass-face '((t :foreground "green"))
     48   "Face for displaying the status of a passing test."
     49   :group 'gotest-ui)
     50 
     51 (defface gotest-ui-skip-face '((t :foreground "grey"))
     52   "Face for displaying the status of a skipped test."
     53   :group 'gotest-ui)
     54 
     55 (defface gotest-ui-fail-face '((t :foreground "pink" :weight bold))
     56   "Face for displaying the status of a failed test."
     57   :group 'gotest-ui)
     58 
     59 (defface gotest-ui-link-face '((t :foreground "white" :weight bold))
     60   "Face for displaying links to go source files."
     61   :group 'gotest-ui)
     62 
     63 (defcustom gotest-ui-expand-test-statuses '(fail)
     64   "Statuses to expand test cases for.
     65 Whenever a test enters this state, it is automatically expanded."
     66   :group 'gotest-ui)
     67 
     68 (defcustom gotest-ui-test-binary '("go")
     69   "Command list used to invoke the `go' binary."
     70   :group 'gotest-ui)
     71 
     72 (defcustom gotest-ui-test-args '("test" "-json")
     73   "Argument list used to run tests with JSON output."
     74   :group 'gotest-ui)
     75 
     76 (defcustom gotest-ui-additional-test-args '()
     77   "Additional args to pass to `go test'."
     78   :group 'gotest-ui)
     79 
     80 ;;;; Data model:
     81 
     82 (defstruct (gotest-ui-section :named
     83                               (:constructor gotest-ui-section-create)
     84                               (:type vector)
     85                               (:predicate gotest-ui-section-p))
     86   title tests node)
     87 
     88 ;;; `gotest-ui-thing' is a thing that can be under test: a
     89 ;;; package, or a single test.
     90 
     91 (defstruct gotest-ui-thing
     92   (name)
     93   (node)
     94   (expanded-p)
     95   (status)
     96   (buffer)    ; the buffer containing this test's output
     97   (elapsed)   ; a floating-point amount of seconds
     98   )
     99 
    100 ;;; `gotest-ui-test' is a single test. It contains a status and
    101 ;;; output.
    102 (defstruct (gotest-ui-test (:include gotest-ui-thing)
    103                            (:constructor gotest-ui--make-test-1))
    104   (package)
    105   (reason))
    106 
    107 (defun gotest-ui-test->= (test1 test2)
    108   "Returns true if TEST1's name sorts greater than TEST2's."
    109   (let ((pkg1 (gotest-ui-test-package test1))
    110         (pkg2 (gotest-ui-test-package test2))
    111         (name1 (or (gotest-ui-thing-name test1) ""))
    112         (name2 (or (gotest-ui-thing-name test2) "")))
    113     (if (string= pkg1 pkg2)
    114         (string> name1 name2)
    115       (string> pkg1 pkg2))))
    116 
    117 (defstruct (gotest-ui-status (:constructor gotest-ui--make-status-1))
    118   (state)
    119   (cmdline)
    120   (dir)
    121   (output)
    122   (node))
    123 
    124 (cl-defun gotest-ui--make-status (ewoc cmdline dir)
    125   (let ((status (gotest-ui--make-status-1 :state 'run :cmdline (s-join " " cmdline) :dir dir)))
    126     (let ((node (ewoc-enter-first ewoc status)))
    127       (setf (gotest-ui-status-node status) node))
    128     status))
    129 
    130 (cl-defun gotest-ui--make-test (ewoc &rest args &key status package name &allow-other-keys)
    131   (apply #'gotest-ui--make-test-1 :status (or status "run") args))
    132 
    133 ;;; Data manipulation routines:
    134 
    135 (cl-defun gotest-ui-ensure-test (ewoc package-name base-name &key (status 'run))
    136   (let* ((test-name (format "%s.%s" package-name base-name))
    137          (test (gethash test-name gotest-ui--tests)))
    138     (if test
    139         test
    140       (setf (gethash test-name gotest-ui--tests)
    141             (gotest-ui--make-test ewoc :name base-name :package package-name :status status)))))
    142 
    143 (defun gotest-ui-update-status (new-state)
    144   (setf (gotest-ui-status-state gotest-ui--status) new-state)
    145   (ewoc-invalidate gotest-ui--ewoc (gotest-ui-status-node gotest-ui--status)))
    146 
    147 (defun gotest-ui-update-status-output (new-output)
    148   (setf (gotest-ui-status-output gotest-ui--status) new-output)
    149   (ewoc-invalidate gotest-ui--ewoc (gotest-ui-status-node gotest-ui--status)))
    150 
    151 (defun gotest-ui-ensure-output-buffer (thing)
    152   (unless (gotest-ui-thing-buffer thing)
    153     (with-current-buffer
    154         (setf (gotest-ui-thing-buffer thing)
    155               (generate-new-buffer (format " *%s" (gotest-ui-thing-name thing))))
    156       (setq-local gotest-ui-parse-marker (point-min-marker))
    157       (setq-local gotest-ui-insertion-marker (point-min-marker))
    158       (set-marker-insertion-type gotest-ui-insertion-marker t)))
    159   (gotest-ui-thing-buffer thing))
    160 
    161 (defun gotest-ui-mouse-open-file (event)
    162   "In gotest-ui mode, open the file/line reference in another window."
    163   (interactive "e")
    164   (let ((window (posn-window (event-end event)))
    165         (pos (posn-point (event-end event)))
    166         file line)
    167     (if (not (windowp window))
    168         (error "No file chosen"))
    169     (with-current-buffer (window-buffer window)
    170       (goto-char pos)
    171       (gotest-ui-open-file-at-point))))
    172 
    173 (defun gotest-ui-open-file-at-point ()
    174   (interactive)
    175   (let ((file (gotest-ui-get-file-for-visit))
    176         (line (gotest-ui-get-line-for-visit)))
    177     (unless (file-exists-p file)
    178       (error "Could not open %s:%d" file line))
    179     (with-current-buffer (find-file-other-window file)
    180       (goto-char (point-min))
    181       (when line
    182         (forward-line (1- line))))))
    183 
    184 (defun gotest-ui-get-file-for-visit ()
    185   (get-text-property (point) 'gotest-ui-file))
    186 
    187 (defun gotest-ui-get-line-for-visit ()
    188   (string-to-number (get-text-property (point) 'gotest-ui-line)))
    189 
    190 (defun gotest-ui-file-from-gopath (package file-basename)
    191   (if (or (file-name-absolute-p file-basename)
    192           (string-match-p "/" file-basename))
    193       file-basename
    194     (let ((gopath (or (getenv "GOPATH")
    195                       (expand-file-name "~/go"))))
    196       (expand-file-name (concat gopath "/src/" package "/" file-basename)))))
    197 
    198 (defvar gotest-ui-click-map
    199   (let ((map (make-sparse-keymap)))
    200     (define-key map [mouse-2] 'gotest-ui-mouse-open-file)
    201     map))
    202 
    203 (defun gotest-ui-ensure-parsed (thing)
    204   (save-excursion
    205     (goto-char gotest-ui-parse-marker)
    206     (while (re-search-forward "\\([^ \t]+\\.go\\):\\([0-9]+\\)" gotest-ui-insertion-marker t)
    207       (let* ((file-basename (match-string 1))
    208              (file (gotest-ui-file-from-gopath (gotest-ui-test-package thing) file-basename)))
    209         (set-text-properties (match-beginning 0) (match-end 0)
    210                              `(face gotest-ui-link-face
    211                                     gotest-ui-file ,file
    212                                     gotest-ui-line ,(match-string 2)
    213                                     keymap ,gotest-ui-click-map
    214                                     follow-link t
    215                                     ))))
    216     (set-marker gotest-ui-parse-marker gotest-ui-insertion-marker)))
    217 
    218 (defun gotest-ui-update-thing-output (thing output)
    219   (with-current-buffer (gotest-ui-ensure-output-buffer thing)
    220     (goto-char gotest-ui-insertion-marker)
    221     (let ((overwrites (split-string output "\r")))
    222       (insert (car overwrites))
    223       (dolist (segment (cdr overwrites))
    224         (let ((delete-to (point)))
    225           (forward-line 0)
    226           (delete-region (point) delete-to))
    227         (insert segment)))
    228     (set-marker gotest-ui-insertion-marker (point))
    229     (gotest-ui-ensure-parsed thing)))
    230 
    231 ;; TODO: clean up buffers on kill
    232 
    233 ;;;; Mode definition
    234 
    235 (defvar gotest-ui-mode-map
    236   (let ((m (make-sparse-keymap)))
    237     (suppress-keymap m)
    238     ;; key bindings go here
    239     (define-key m (kbd "TAB") 'gotest-ui-toggle-expanded)
    240     (define-key m (kbd "g") 'gotest-ui-rerun)
    241     (define-key m (kbd "RET") 'gotest-ui-open-file-at-point)
    242     m))
    243 
    244 (define-derived-mode gotest-ui-mode special-mode "go test UI"
    245   "Major mode for running go test with JSON output."
    246   (setq truncate-lines t)
    247   (setq buffer-read-only t)
    248   (setq-local line-move-visual t)
    249   (setq show-trailing-whitespace nil)
    250   (setq list-buffers-directory default-directory)
    251   (make-local-variable 'text-property-default-nonsticky)
    252   (push (cons 'keymap t) text-property-default-nonsticky))
    253 
    254 
    255 (defun gotest-ui--clear-buffer (buffer)
    256   (let ((dir default-directory))
    257     (with-current-buffer buffer
    258       (when (buffer-live-p gotest-ui--process-buffer)
    259         (kill-buffer gotest-ui--process-buffer))
    260       (kill-all-local-variables)
    261       (let  ((buffer-read-only nil))
    262         (erase-buffer))
    263       (buffer-disable-undo)
    264       (setq-local default-directory dir))))
    265 
    266 (defun gotest-ui--setup-buffer (buffer name cmdline dir)
    267   (setq-local default-directory dir)
    268   (setq gotest-ui--cmdline cmdline
    269         gotest-ui--dir dir)
    270   (let ((ewoc (ewoc-create 'gotest-ui--pp-test nil nil t))
    271         (tests (make-hash-table :test #'equal)))
    272     (setq gotest-ui--tests tests)
    273     (setq gotest-ui--ewoc ewoc)
    274     ;; Drop in the first few ewoc nodes:
    275     (setq gotest-ui--status (gotest-ui--make-status ewoc cmdline dir))
    276     (gotest-ui-add-section gotest-ui--ewoc 'fail "Failed Tests:")
    277     (gotest-ui-add-section gotest-ui--ewoc 'run "Currently Running:")
    278     (gotest-ui-add-section gotest-ui--ewoc 'skip "Skipped:")
    279     (gotest-ui-add-section gotest-ui--ewoc 'pass "Passed Tests:"))
    280   ;; Set up the other buffers:
    281   (setq gotest-ui--stderr-process-buffer (generate-new-buffer (format " *%s (stderr)" name)))
    282   (with-current-buffer gotest-ui--stderr-process-buffer
    283     (setq gotest-ui--ui-buffer buffer))
    284   (setq gotest-ui--process-buffer (generate-new-buffer (format " *%s" name)))
    285   (with-current-buffer gotest-ui--process-buffer
    286     (setq gotest-ui--ui-buffer buffer)))
    287 
    288 (defun gotest-ui-add-section (ewoc state name)
    289   (let ((section (gotest-ui-section-create :title name :tests (list nil))))
    290     (setf (gotest-ui-section-node section)
    291           (ewoc-enter-last ewoc section))
    292     (push (cons state section) gotest-ui--section-alist)))
    293 
    294 (defun gotest-ui-sort-test-into-section (test previous-state)
    295   (let (invalidate-nodes)
    296     (when-let ((previous-section* (and previous-state
    297                                        (assoc previous-state gotest-ui--section-alist))))
    298       (let ((previous-section (cdr previous-section*)))
    299         (setf (gotest-ui-section-tests previous-section)
    300               (delete test (gotest-ui-section-tests previous-section)))
    301         (when (null (cdr (gotest-ui-section-tests previous-section)))
    302           (push (gotest-ui-section-node previous-section) invalidate-nodes))))
    303     ;; Drop the node from the buffer:
    304     (when-let (node (gotest-ui-thing-node test))
    305       (let ((buffer-read-only nil))
    306         (ewoc-delete gotest-ui--ewoc node))
    307       (setf (gotest-ui-thing-node test) nil))
    308 
    309     ;; Put it in the next secion:
    310     (when-let ((section* (assoc (gotest-ui-thing-status test)
    311                                 gotest-ui--section-alist)))
    312       (let* ((section (cdr section*))
    313              (insertion-cons (gotest-ui-section-tests section)))
    314         (while (and (cdr insertion-cons)
    315                     (gotest-ui-test->= test (cadr insertion-cons)))
    316           (setq insertion-cons (cdr insertion-cons)))
    317         (rplacd insertion-cons (cons test (cdr insertion-cons)))
    318         (let ((insertion-node (if (car insertion-cons)
    319                                   (gotest-ui-thing-node (car insertion-cons))
    320                                 (gotest-ui-section-node section))))
    321          (setf (gotest-ui-thing-node test)
    322                (ewoc-enter-after gotest-ui--ewoc insertion-node test)))
    323         (when (null (cddr (gotest-ui-section-tests section)))
    324           (push (gotest-ui-section-node section) invalidate-nodes))))
    325     (unless (null invalidate-nodes)
    326       (apply 'ewoc-invalidate gotest-ui--ewoc invalidate-nodes))
    327     (gotest-ui-thing-node test)))
    328 
    329 ;;;; Commands:
    330 
    331 (defun gotest-ui-toggle-expanded ()
    332   "Toggle expandedness of a test/package node"
    333   (interactive)
    334   (let* ((node (ewoc-locate gotest-ui--ewoc (point)))
    335          (data (ewoc-data node)))
    336     (when (and data (gotest-ui-thing-p data))
    337       (setf (gotest-ui-thing-expanded-p data)
    338             (not (gotest-ui-thing-expanded-p data)))
    339       (ewoc-invalidate gotest-ui--ewoc node))))
    340 
    341 (defun gotest-ui-rerun ()
    342   (interactive)
    343   (gotest-ui gotest-ui--cmdline :dir gotest-ui--dir))
    344 
    345 ;;;; Displaying the data:
    346 
    347 (defvar-local gotest-ui--tests nil)
    348 (defvar-local gotest-ui--section-alist nil)
    349 (defvar-local gotest-ui--ewoc nil)
    350 (defvar-local gotest-ui--status nil)
    351 (defvar-local gotest-ui--process-buffer nil)
    352 (defvar-local gotest-ui--stderr-process-buffer nil)
    353 (defvar-local gotest-ui--ui-buffer nil)
    354 (defvar-local gotest-ui--process nil)
    355 (defvar-local gotest-ui--stderr-process nil)
    356 (defvar-local gotest-ui--cmdline nil)
    357 (defvar-local gotest-ui--dir nil)
    358 
    359 (cl-defun gotest-ui (cmdline &key dir)
    360   (let* ((dir (or dir default-directory))
    361          (name (format "*go test: %s in %s" (s-join " " cmdline) dir))
    362          (buffer (get-buffer-create name)))
    363     (unless (eql buffer (current-buffer))
    364       (display-buffer buffer))
    365     (with-current-buffer buffer
    366       (let ((default-directory dir))
    367         (gotest-ui--clear-buffer buffer)
    368         (gotest-ui-mode)
    369         (gotest-ui--setup-buffer buffer name cmdline dir))
    370       (setq gotest-ui--stderr-process
    371             (make-pipe-process :name (s-concat name "(stderr)")
    372                                :buffer gotest-ui--stderr-process-buffer
    373                                :sentinel #'gotest-ui--stderr-process-sentinel
    374                                :filter #'gotest-ui-read-stderr))
    375       (setq gotest-ui--process
    376             (make-process :name name
    377                           :buffer gotest-ui--process-buffer
    378                           :sentinel #'gotest-ui--process-sentinel
    379                           :filter #'gotest-ui-read-stdout
    380                           :stderr gotest-ui--stderr-process
    381                           :command cmdline)))))
    382 
    383 (defun gotest-ui-pp-status (status)
    384   (propertize (format "%s" status)
    385               'face
    386               (case status
    387                 (fail 'gotest-ui-fail-face)
    388                 (skip 'gotest-ui-skip-face)
    389                 (pass 'gotest-ui-pass-face)
    390                 (otherwise 'default))))
    391 
    392 (defun gotest-ui--pp-test-output (test)
    393   (with-current-buffer (gotest-ui-ensure-output-buffer test)
    394     (propertize (buffer-substring (point-min) (point-max))
    395                 'line-prefix "\t")))
    396 
    397 (defun gotest-ui--pp-test (test)
    398   (cond
    399    ((gotest-ui-section-p test)
    400     (unless (null (cdr (gotest-ui-section-tests test)))
    401       (insert "\n" (gotest-ui-section-title test) "\n")))
    402    ((gotest-ui-status-p test)
    403     (insert (gotest-ui-pp-status (gotest-ui-status-state test)))
    404     (insert (format " %s in %s\n\n"
    405                     (gotest-ui-status-cmdline test)
    406                     (gotest-ui-status-dir test)))
    407     (unless (zerop (length (gotest-ui-status-output test)))
    408       (insert (format "\n\n%s" (gotest-ui-status-output test)))))
    409    ((gotest-ui-test-p test)
    410     (let ((status (gotest-ui-thing-status test))
    411           (package (gotest-ui-test-package test))
    412           (name (gotest-ui-thing-name test)))
    413       (insert (gotest-ui-pp-status status))
    414       (insert " ")
    415       (insert (if name
    416                   (format "%s.%s" package name)
    417                 package))
    418       (when-let ((elapsed (gotest-ui-thing-elapsed test)))
    419         (insert (format " (%.3fs)" elapsed)))
    420       (when-let ((reason (gotest-ui-test-reason test)))
    421         (insert (format " [%s]" reason))))
    422     (when (and (gotest-ui-thing-expanded-p test)
    423                (> (length (gotest-ui--pp-test-output test)) 0))
    424       (insert "\n")
    425       (insert (gotest-ui--pp-test-output test)))
    426     (insert "\n"))))
    427 
    428 ;;;; Handling input:
    429 
    430 (defun gotest-ui--process-sentinel (proc event)
    431   (let* ((process-buffer (process-buffer proc))
    432          (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
    433          (inhibit-quit t))
    434     (with-local-quit
    435       (with-current-buffer ui-buffer
    436         (cond
    437          ((string= event "finished\n")
    438           (gotest-ui-update-status 'pass))
    439          ((s-prefix-p "exited abnormally" event)
    440           (gotest-ui-update-status 'fail))
    441          (t
    442           (gotest-ui-update-status event)))))))
    443 
    444 (defun gotest-ui--stderr-process-sentinel (proc event)
    445   ;; ignore all events
    446   nil)
    447 
    448 (defun gotest-ui-read-stderr (proc input)
    449   (let* ((process-buffer (process-buffer proc))
    450          (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
    451          (inhibit-quit t))
    452     (with-local-quit
    453       (when (buffer-live-p process-buffer)
    454         (with-current-buffer process-buffer
    455           (gotest-ui-read-compiler-spew proc process-buffer ui-buffer input))))))
    456 
    457 (defun gotest-ui-read-stdout (proc input)
    458   (let* ((process-buffer (process-buffer proc))
    459          (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
    460          (inhibit-quit t))
    461     (with-local-quit
    462       (when (buffer-live-p process-buffer)
    463         (gotest-ui-read-json process-buffer (process-mark proc) input)))))
    464 
    465 (defun gotest-ui-read-json (process-buffer marker input)
    466   (with-current-buffer process-buffer
    467     (gotest-ui-read-json-1 process-buffer marker gotest-ui--ui-buffer input)))
    468 
    469 (defvar-local gotest-ui--current-failing-test nil)
    470 
    471 (defun gotest-ui-read-failing-package (ui-buffer)
    472   (when (looking-at "^# \\(.*\\)$")
    473     (let* ((package (match-string 1))
    474            test)
    475       (with-current-buffer ui-buffer
    476         (setq test (gotest-ui-ensure-test gotest-ui--ewoc package nil :status 'fail))
    477         (gotest-ui-maybe-expand test)
    478         (gotest-ui-sort-test-into-section test nil))
    479       (forward-line 1)
    480       test)))
    481 
    482 (defun gotest-ui-read-compiler-spew (proc process-buffer ui-buffer input)
    483   (with-current-buffer process-buffer
    484     (save-excursion
    485       (goto-char (point-max))
    486       (insert input)
    487       (goto-char (process-mark proc))
    488       (while (and (/= (point-max) (line-end-position)) ; incomplete line
    489                   (/= (point-max) (point)))
    490         (cond
    491          (gotest-ui--current-failing-test
    492           (cond
    493            ((looking-at "^# \\(.*\\)$")
    494             (gotest-ui-read-failing-package ui-buffer))
    495            (t
    496             (let* ((line (buffer-substring (point) (line-end-position)))
    497                    (test gotest-ui--current-failing-test))
    498               (forward-line 1)
    499               (set-marker (process-mark proc) (point))
    500               (with-current-buffer ui-buffer
    501                 (gotest-ui-update-thing-output test (concat line "\n"))
    502                 (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test)))))))
    503          (t
    504           (let ((test (gotest-ui-read-failing-package ui-buffer)))
    505             (setq gotest-ui--current-failing-test test)
    506             (set-marker (process-mark proc) (point))
    507             (with-current-buffer ui-buffer
    508               (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test))))))))))
    509 
    510 (defun gotest-ui-read-json-1 (process-buffer marker ui-buffer input)
    511   (with-current-buffer process-buffer
    512     (save-excursion
    513       ;; insert the chunk of output at the end
    514       (goto-char (point-max))
    515       (insert input)
    516 
    517       ;; try to read the next object (which is hopefully complete now):
    518       (let ((nodes
    519              (cl-loop
    520               for (node . continue) = (gotest-ui-read-test-event process-buffer marker ui-buffer)
    521               when node collect node into nodes
    522               while continue
    523               finally (return nodes))))
    524         (when nodes
    525           (with-current-buffer ui-buffer
    526             (apply #'ewoc-invalidate gotest-ui--ewoc
    527                    (cl-remove-if-not (lambda (node) (marker-buffer (ewoc-location node))) (cl-remove-duplicates nodes)))))))))
    528 
    529 (defun gotest-ui-read-test-event (process-buffer marker ui-buffer)
    530   (goto-char marker)
    531   (when (= (point) (line-end-position))
    532     (forward-line 1))
    533   (case (char-after (point))
    534     (?\{
    535      ;; It's JSON:
    536      (condition-case err
    537          (let ((obj (json-read)))
    538            (set-marker marker (point))
    539            (with-current-buffer ui-buffer
    540              (cons (gotest-ui-update-test-status obj) t)))
    541        (json-error (cons nil nil))
    542        (wrong-type-argument
    543         (if (and (eql (cadr err) 'characterp)
    544                  (eql (caddr err) :json-eof))
    545             ;; This is peaceful & we can ignore it:
    546             (cons nil nil)
    547           (signal 'wrong-type-argument err)))))
    548     (?\F
    549      ;; It's a compiler error:
    550      (when (looking-at "^FAIL\t\\(.*\\)\s+\\[\\([^]]+\\)\\]\n")
    551        (let* ((package-name (match-string 1))
    552               (reason (match-string 2))
    553               test node)
    554          (with-current-buffer ui-buffer
    555            (setq test (gotest-ui-ensure-test gotest-ui--ewoc package-name nil :status 'fail)
    556                  node (gotest-ui-thing-node test))
    557            (setf (gotest-ui-test-reason test) reason)
    558            (gotest-ui-sort-test-into-section test nil)
    559            (gotest-ui-maybe-expand test))
    560          (forward-line 1)
    561          (set-marker marker (point))
    562          (cons node t))))
    563     (otherwise
    564      ;; We're done:
    565      (cons nil nil))))
    566 
    567 (defun gotest-ui-maybe-expand (test)
    568   (when (memq (gotest-ui-test-status test) gotest-ui-expand-test-statuses)
    569     (setf (gotest-ui-test-expanded-p test) t)))
    570 
    571 (defun gotest-ui-update-test-status (json)
    572   (let-alist json
    573     (let* ((action (intern .Action))
    574            (test (gotest-ui-ensure-test gotest-ui--ewoc .Package .Test))
    575            (previous-status (gotest-ui-thing-status test)))
    576       (case action
    577         (run
    578          (gotest-ui-sort-test-into-section test nil))
    579         (output (gotest-ui-update-thing-output test .Output))
    580         (pass
    581          (setf (gotest-ui-thing-status test) 'pass
    582                (gotest-ui-thing-elapsed test) .Elapsed)
    583          (gotest-ui-sort-test-into-section test previous-status)
    584          (gotest-ui-maybe-expand test))
    585         (fail
    586          (setf (gotest-ui-thing-status test) 'fail
    587                (gotest-ui-thing-elapsed test) .Elapsed)
    588          (gotest-ui-sort-test-into-section test previous-status)
    589          (gotest-ui-maybe-expand test))
    590         (skip
    591          (setf (gotest-ui-thing-status test) 'skip
    592                (gotest-ui-thing-elapsed test) .Elapsed)
    593          (gotest-ui-sort-test-into-section test previous-status)
    594          (gotest-ui-maybe-expand test))
    595         (otherwise
    596          (setq test nil)))
    597       (when test (gotest-ui-thing-node test)))))
    598 
    599 ;;;; Commands for go-mode:
    600 
    601 (defun gotest-ui--command-line (&rest cmdline)
    602   (append gotest-ui-test-binary gotest-ui-test-args gotest-ui-additional-test-args
    603           cmdline))
    604 
    605 ;;;###autoload
    606 (defun gotest-ui-current-test ()
    607   "Launch go test with the test that (point) is in."
    608   (interactive)
    609   (cl-destructuring-bind (test-suite test-name) (go-test--get-current-test-info)
    610     (let ((test-flag (if (> (length test-suite) 0) "-m" "-run")))
    611       (when test-name
    612         (gotest-ui (gotest-ui--command-line test-flag (s-concat test-name "$") "."))))))
    613 
    614 ;;;###autoload
    615 (defun gotest-ui-current-file ()
    616   "Launch go test on the current buffer file."
    617   (interactive)
    618   (let* ((data (go-test--get-current-file-testing-data))
    619          (run-flag (s-concat "-run=" data "$")))
    620     (gotest-ui (gotest-ui--command-line run-flag "."))))
    621 
    622 ;;;###autoload
    623 (defun gotest-ui-current-project ()
    624   "Launch go test on the current buffer's project."
    625   (interactive)
    626   (let ((default-directory (projectile-project-root)))
    627     (gotest-ui (gotest-ui--command-line "./..."))))
    628 
    629 (provide 'gotest-ui)
    630 
    631 ;;; gotest-ui.el ends here