gotest-ui.el

;;; gotest-ui.el --- Major mode for running go test -json
;;
;; Copyright (C) 2018-2020 Andreas Fuchs
;;
;; Authors: Andreas Fuchs <asf@boinkor.net>
;; URL: https://github.com/antifuchs/gotest-ui-mode
;; Created: Feb 18, 2018
;; Keywords: languages go
;; Version: 0.1.0
;; Package-Requires: ((emacs "25") (s "1.12.0") (gotest "0.14.0") (projectile "2.2.0"))
;;
;; This file is not a part of GNU Emacs.
;;
;; License:
;; 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.0, 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, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;;; Commentary:
;;
;; This package support for running go tests with a nice user interface
;; that allows folding away output, highlighting failing tests.
;;
;;; Code:

(eval-when-compile
  (require 'cl-macs))

(require 'cl-seq)
(require 'subr-x)
(require 'ewoc)
(require 'json)
(require 'compile)

(require 'projectile)
(require 'gotest)
(require 's)

(defgroup gotest-ui nil
  "The go test runner."
  :group 'tools)

(defface gotest-ui-pass-face '((t :foreground "green"))
  "Face for displaying the status of a passing test."
  :group 'gotest-ui)

(defface gotest-ui-skip-face '((t :foreground "grey"))
  "Face for displaying the status of a skipped test."
  :group 'gotest-ui)

(defface gotest-ui-fail-face '((t :foreground "pink" :weight bold))
  "Face for displaying the status of a failed test."
  :group 'gotest-ui)

(defface gotest-ui-link-face '((t :foreground "white" :weight bold))
  "Face for displaying links to go source files."
  :group 'gotest-ui)

(defcustom gotest-ui-expand-test-statuses '(fail)
  "Statuses to expand test cases for.
Whenever a test enters this state, it is automatically expanded."
  :group 'gotest-ui
  :type '(repeat symbol))

(defcustom gotest-ui-test-binary '("go")
  "Command list used to invoke the `go' binary."
  :group 'gotest-ui
  :type '(repeat string))

(defcustom gotest-ui-test-args '("test" "-json")
  "Argument list used to run tests with JSON output."
  :group 'gotest-ui
  :type '(repeat string))

(defcustom gotest-ui-additional-test-args '()
  "Additional args to pass to `go test'."
  :group 'gotest-ui
  :type '(repeat string))

(defvar-local gotest-ui--tests nil)
(defvar-local gotest-ui--section-alist nil)
(defvar-local gotest-ui--ewoc nil)
(defvar-local gotest-ui--status nil)
(defvar-local gotest-ui--process-buffer nil)
(defvar-local gotest-ui--stderr-process-buffer nil)
(defvar-local gotest-ui--ui-buffer nil)
(defvar-local gotest-ui--process nil)
(defvar-local gotest-ui--stderr-process nil)
(defvar-local gotest-ui--cmdline nil)
(defvar-local gotest-ui--dir nil)
(defvar gotest-ui-parse-marker)
(defvar gotest-ui-insertion-marker)

;;;; Data model:

(cl-defstruct (gotest-ui-section :named
                              (:constructor gotest-ui-section-create)
                              (:type vector)
                              (:predicate gotest-ui-section-p))
  title tests node)

;;; `gotest-ui-thing' is a thing that can be under test: a
;;; package, or a single test.

(cl-defstruct gotest-ui-thing
  (name)
  (node)
  (expanded-p)
  (status)
  (buffer)    ; the buffer containing this test's output
  (elapsed)   ; a floating-point amount of seconds
  )

;;; `gotest-ui-test' is a single test. It contains a status and
;;; output.
(cl-defstruct (gotest-ui-test (:include gotest-ui-thing)
                           (:constructor gotest-ui--make-test-1))
  (package)
  (reason))

(defun gotest-ui-test->= (test1 test2)
  "Return non-nil if TEST1's name sort greater than TEST2's."
  (let ((pkg1 (gotest-ui-test-package test1))
        (pkg2 (gotest-ui-test-package test2))
        (name1 (or (gotest-ui-thing-name test1) ""))
        (name2 (or (gotest-ui-thing-name test2) "")))
    (if (string= pkg1 pkg2)
        (string> name1 name2)
      (string> pkg1 pkg2))))

(cl-defstruct (gotest-ui-status (:constructor gotest-ui--make-status-1))
  (state)
  (cmdline)
  (dir)
  (output)
  (node))

(cl-defun gotest-ui--make-status (ewoc cmdline dir)
  "Construct a test result status for EWOC, running CMDLINE in DIR."
  (let ((status (gotest-ui--make-status-1 :state 'run :cmdline (s-join " " cmdline) :dir dir)))
    (let ((node (ewoc-enter-first ewoc status)))
      (setf (gotest-ui-status-node status) node))
    status))

(cl-defun gotest-ui--make-test (ewoc &rest args &key status package name &allow-other-keys)
  "Construct a test result object.
EWOC is the ewoc instance for that results buffer, ARGS holds the remaining
arguments; STATUS is the test result state, PACKAGE is the go pkg
holding the test,and NAME is the name of the test."
  (apply #'gotest-ui--make-test-1 :status (or status "run") args))

;;; Data manipulation routines:

(cl-defun gotest-ui-ensure-test (ewoc package-name base-name &key (status 'run))
  "Ensure a test result collector exists.

EWOC is the ewoc instance for the test results buffer; PACKAGE-NAME is
the go pkg name, BASE-NAME is the filename inside that go package, and
STATUS is the status of the test (usually 'run)."
  (let* ((test-name (format "%s.%s" package-name base-name))
         (test (gethash test-name gotest-ui--tests)))
    (if test
        test
      (setf (gethash test-name gotest-ui--tests)
            (gotest-ui--make-test ewoc :name base-name :package package-name :status status)))))

(defun gotest-ui-update-status (new-state)
  "Update overall result status to NEW-STATE."
  (setf (gotest-ui-status-state gotest-ui--status) new-state)
  (ewoc-invalidate gotest-ui--ewoc (gotest-ui-status-node gotest-ui--status)))

(defun gotest-ui-ensure-output-buffer (thing)
  "Ensure a buffer for test result output of THING exists."
  (unless (gotest-ui-thing-buffer thing)
    (with-current-buffer
        (setf (gotest-ui-thing-buffer thing)
              (generate-new-buffer (format " *%s" (gotest-ui-thing-name thing))))
      (setq-local gotest-ui-parse-marker (point-min-marker))
      (setq-local gotest-ui-insertion-marker (point-min-marker))
      (set-marker-insertion-type gotest-ui-insertion-marker t)))
  (gotest-ui-thing-buffer thing))

(defun gotest-ui-mouse-open-file (event)
  "Open the file/line reference from EVENT in another window."
  (interactive "e")
  (let ((window (posn-window (event-end event)))
        (pos (posn-point (event-end event)))
        file line)
    (if (not (windowp window))
        (error "No file chosen"))
    (with-current-buffer (window-buffer window)
      (goto-char pos)
      (gotest-ui-open-file-at-point))))

(defun gotest-ui-open-file-at-point ()
  "Open the file/line at the current point."
  (interactive)
  (let ((file (gotest-ui-get-file-for-visit))
        (line (gotest-ui-get-line-for-visit)))
    (unless (file-exists-p file)
      (error "Could not open %s:%d" file line))
    (with-current-buffer (find-file-other-window file)
      (goto-char (point-min))
      (when line
        (forward-line (1- line))))))

(defun gotest-ui-get-file-for-visit ()
  "Return the file name from a go file reference."
  (get-text-property (point) 'gotest-ui-file))

(defun gotest-ui-get-line-for-visit ()
  "Return the line number from a go file reference."
  (string-to-number (get-text-property (point) 'gotest-ui-line)))

(defun gotest-ui-file-from-gopath (package file-basename)
  "Return an expanded file name for reaching FILE-BASENAME in go pkg PACKAGE."
  (if (or (file-name-absolute-p file-basename)
          (string-match-p "/" file-basename))
      file-basename
    (let ((gopath (or (getenv "GOPATH")
                      (expand-file-name "~/go"))))
      (expand-file-name (concat gopath "/src/" package "/" file-basename)))))

(defvar gotest-ui-click-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'gotest-ui-mouse-open-file)
    map))

(defun gotest-ui-ensure-parsed (thing)
  "Parse the output in THING and ensure that .go file references are link-ified."
  (save-excursion
    (goto-char gotest-ui-parse-marker)
    (while (re-search-forward "\\([^ \t]+\\.go\\):\\([0-9]+\\)" gotest-ui-insertion-marker t)
      (let* ((file-basename (match-string 1))
             (file (gotest-ui-file-from-gopath (gotest-ui-test-package thing) file-basename)))
        (set-text-properties (match-beginning 0) (match-end 0)
                             `(face gotest-ui-link-face
                                    gotest-ui-file ,file
                                    gotest-ui-line ,(match-string 2)
                                    keymap ,gotest-ui-click-map
                                    follow-link t
                                    ))))
    (set-marker gotest-ui-parse-marker gotest-ui-insertion-marker)))

(defun gotest-ui-update-thing-output (thing output)
  "Update the THING (a test result), with OUTPUT."
  (with-current-buffer (gotest-ui-ensure-output-buffer thing)
    (goto-char gotest-ui-insertion-marker)
    (let ((overwrites (split-string output "\r")))
      (insert (car overwrites))
      (dolist (segment (cdr overwrites))
        (let ((delete-to (point)))
          (forward-line 0)
          (delete-region (point) delete-to))
        (insert segment)))
    (set-marker gotest-ui-insertion-marker (point))
    (gotest-ui-ensure-parsed thing)))

;; TODO: clean up buffers on kill

;;;; Mode definition

(defvar gotest-ui-mode-map
  (let ((m (make-sparse-keymap)))
    (suppress-keymap m)
    ;; key bindings go here
    (define-key m (kbd "TAB") 'gotest-ui-toggle-expanded)
    (define-key m (kbd "g") 'gotest-ui-rerun)
    (define-key m (kbd "RET") 'gotest-ui-open-file-at-point)
    m))

(define-derived-mode gotest-ui-mode special-mode "go test UI"
  "Major mode for running go test with JSON output."
  (setq truncate-lines t)
  (setq buffer-read-only t)
  (setq-local line-move-visual t)
  (setq show-trailing-whitespace nil)
  (setq list-buffers-directory default-directory)
  (make-local-variable 'text-property-default-nonsticky)
  (push (cons 'keymap t) text-property-default-nonsticky))


(defun gotest-ui--clear-buffer (buffer)
  "Clear the gotest-ui results state from BUFFER."
  (let ((dir default-directory))
    (with-current-buffer buffer
      (when (buffer-live-p gotest-ui--process-buffer)
        (kill-buffer gotest-ui--process-buffer))
      (kill-all-local-variables)
      (let  ((buffer-read-only nil))
        (erase-buffer))
      (buffer-disable-undo)
      (setq-local default-directory dir))))

(defun gotest-ui--setup-buffer (buffer name cmdline dir)
  "Setup BUFFER as a gotest-ui results buffer.

NAME is the buffer name, CMDLINE is the command line to invoke
`go test` with, and DIR is the current-directory in which to run
the command line."
  (setq-local default-directory dir)
  (setq gotest-ui--cmdline cmdline
        gotest-ui--dir dir)
  (let ((ewoc (ewoc-create 'gotest-ui--pp-test nil nil t))
        (tests (make-hash-table :test #'equal)))
    (setq gotest-ui--tests tests)
    (setq gotest-ui--ewoc ewoc)
    ;; Drop in the first few ewoc nodes:
    (setq gotest-ui--status (gotest-ui--make-status ewoc cmdline dir))
    (gotest-ui-add-section gotest-ui--ewoc 'fail "Failed Tests:")
    (gotest-ui-add-section gotest-ui--ewoc 'run "Currently Running:")
    (gotest-ui-add-section gotest-ui--ewoc 'skip "Skipped:")
    (gotest-ui-add-section gotest-ui--ewoc 'pass "Passed Tests:"))
  ;; Set up the other buffers:
  (setq gotest-ui--stderr-process-buffer (generate-new-buffer (format " *%s (stderr)" name)))
  (with-current-buffer gotest-ui--stderr-process-buffer
    (setq gotest-ui--ui-buffer buffer))
  (setq gotest-ui--process-buffer (generate-new-buffer (format " *%s" name)))
  (with-current-buffer gotest-ui--process-buffer
    (setq gotest-ui--ui-buffer buffer)))

(defun gotest-ui-add-section (ewoc state name)
  "Add a section for STATE with NAME to EWOC."
  (let ((section (gotest-ui-section-create :title name :tests (list nil))))
    (setf (gotest-ui-section-node section)
          (ewoc-enter-last ewoc section))
    (push (cons state section) gotest-ui--section-alist)))

(defun gotest-ui-sort-test-into-section (test previous-state)
  "Sort result TEST into the appropriate section, according to its state.

If PREVIOUS-STATE is non-nil, remove the result from the section
that it indicates."
  (let (invalidate-nodes)
    (when-let ((previous-section* (and previous-state
                                       (assoc previous-state gotest-ui--section-alist))))
      (let ((previous-section (cdr previous-section*)))
        (setf (gotest-ui-section-tests previous-section)
              (delete test (gotest-ui-section-tests previous-section)))
        (when (null (cdr (gotest-ui-section-tests previous-section)))
          (push (gotest-ui-section-node previous-section) invalidate-nodes))))
    ;; Drop the node from the buffer:
    (when-let (node (gotest-ui-thing-node test))
      (let ((buffer-read-only nil))
        (ewoc-delete gotest-ui--ewoc node))
      (setf (gotest-ui-thing-node test) nil))

    ;; Put it in the next secion:
    (when-let ((section* (assoc (gotest-ui-thing-status test)
                                gotest-ui--section-alist)))
      (let* ((section (cdr section*))
             (insertion-cons (gotest-ui-section-tests section)))
        (while (and (cdr insertion-cons)
                    (gotest-ui-test->= test (cadr insertion-cons)))
          (setq insertion-cons (cdr insertion-cons)))
        (rplacd insertion-cons (cons test (cdr insertion-cons)))
        (let ((insertion-node (if (car insertion-cons)
                                  (gotest-ui-thing-node (car insertion-cons))
                                (gotest-ui-section-node section))))
         (setf (gotest-ui-thing-node test)
               (ewoc-enter-after gotest-ui--ewoc insertion-node test)))
        (when (null (cddr (gotest-ui-section-tests section)))
          (push (gotest-ui-section-node section) invalidate-nodes))))
    (unless (null invalidate-nodes)
      (apply 'ewoc-invalidate gotest-ui--ewoc invalidate-nodes))
    (gotest-ui-thing-node test)))

;;;; Commands:

(defun gotest-ui-toggle-expanded ()
  "Toggle expandedness of a test/package node."
  (interactive)
  (let* ((node (ewoc-locate gotest-ui--ewoc (point)))
         (data (ewoc-data node)))
    (when (and data (gotest-ui-thing-p data))
      (setf (gotest-ui-thing-expanded-p data)
            (not (gotest-ui-thing-expanded-p data)))
      (ewoc-invalidate gotest-ui--ewoc node))))

(defun gotest-ui-rerun ()
  "Re-run the `go test` run being displayed in the current buffer."
  (interactive)
  (gotest-ui gotest-ui--cmdline :dir gotest-ui--dir))

;;;; Displaying the data:

(cl-defun gotest-ui (cmdline &key dir)
  "Invoke `go test` with CMDLINE in DIR.

This is the generalized entrypoint for gotest-ui, for
programmatic use.  The interactive functions
`gotest-ui-current-file', `gotest-ui-current-test',
`gotest-ui-current-project' should be used interactively."
  (let* ((dir (or dir default-directory))
         (name (format "*go test: %s in %s" (s-join " " cmdline) dir))
         (buffer (get-buffer-create name)))
    (unless (eql buffer (current-buffer))
      (display-buffer buffer))
    (with-current-buffer buffer
      (let ((default-directory dir))
        (gotest-ui--clear-buffer buffer)
        (gotest-ui-mode)
        (gotest-ui--setup-buffer buffer name cmdline dir))
      (setq gotest-ui--stderr-process
            (make-pipe-process :name (s-concat name "(stderr)")
                               :buffer gotest-ui--stderr-process-buffer
                               :sentinel #'gotest-ui--stderr-process-sentinel
                               :filter #'gotest-ui-read-stderr))
      (setq gotest-ui--process
            (make-process :name name
                          :buffer gotest-ui--process-buffer
                          :sentinel #'gotest-ui--process-sentinel
                          :filter #'gotest-ui-read-stdout
                          :stderr gotest-ui--stderr-process
                          :command cmdline)))))

(defun gotest-ui-pp-status (status)
  "Pretty-print STATUS with the appropriate face."
  (propertize (format "%s" status)
              'face
              (cl-case status
                (fail 'gotest-ui-fail-face)
                (skip 'gotest-ui-skip-face)
                (pass 'gotest-ui-pass-face)
                (otherwise 'default))))

(defun gotest-ui--pp-test-output (test)
  "Return the output for TEST as a propertized string."
  (with-current-buffer (gotest-ui-ensure-output-buffer test)
    (propertize (buffer-substring (point-min) (point-max))
                'line-prefix "\t")))

(defun gotest-ui--pp-test (test)
  "Pretty-print TEST into the current buffer."
  (cond
   ((gotest-ui-section-p test)
    (unless (null (cdr (gotest-ui-section-tests test)))
      (insert "\n" (gotest-ui-section-title test) "\n")))
   ((gotest-ui-status-p test)
    (insert (gotest-ui-pp-status (gotest-ui-status-state test)))
    (insert (format " %s in %s\n\n"
                    (gotest-ui-status-cmdline test)
                    (gotest-ui-status-dir test)))
    (unless (zerop (length (gotest-ui-status-output test)))
      (insert (format "\n\n%s" (gotest-ui-status-output test)))))
   ((gotest-ui-test-p test)
    (let ((status (gotest-ui-thing-status test))
          (package (gotest-ui-test-package test))
          (name (gotest-ui-thing-name test)))
      (insert (gotest-ui-pp-status status))
      (insert " ")
      (insert (if name
                  (format "%s.%s" package name)
                package))
      (when-let ((elapsed (gotest-ui-thing-elapsed test)))
        (insert (format " (%.3fs)" elapsed)))
      (when-let ((reason (gotest-ui-test-reason test)))
        (insert (format " [%s]" reason))))
    (when (and (gotest-ui-thing-expanded-p test)
               (> (length (gotest-ui--pp-test-output test)) 0))
      (insert "\n")
      (insert (gotest-ui--pp-test-output test)))
    (insert "\n"))))

;;;; Handling input:

(defun gotest-ui--process-sentinel (proc event)
  "Process sentinel for gotest-ui in PROC.

Processes EVENT, updating the overall test status (depending on
the exit code of the process)."
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (with-current-buffer ui-buffer
        (cond
         ((string= event "finished\n")
          (gotest-ui-update-status 'pass))
         ((s-prefix-p "exited abnormally" event)
          (gotest-ui-update-status 'fail))
         (t
          (gotest-ui-update-status event)))))))

(defun gotest-ui--stderr-process-sentinel (proc event)
  "Acts as the process sentinel for stderr on PROC, ignoring EVENT."
  ;; ignore all events
  nil)

(defun gotest-ui-read-stderr (proc input)
  "Filters stderr output from the go compiler on PROC, reading INPUT."
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (when (buffer-live-p process-buffer)
        (with-current-buffer process-buffer
          (gotest-ui-read-compiler-spew proc process-buffer ui-buffer input))))))

(defun gotest-ui-read-stdout (proc input)
  "Read the stdout of PROC, processing INPUT as json."
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (when (buffer-live-p process-buffer)
        (gotest-ui-read-json process-buffer (process-mark proc) input)))))

(defun gotest-ui-read-json (process-buffer marker input)
  "Read partial json expression INPUT from PROCESS-BUFFER, updating MARKER."
  (with-current-buffer process-buffer
    (gotest-ui-read-json-1 process-buffer marker gotest-ui--ui-buffer input)))

(defvar-local gotest-ui--current-failing-test nil)

(defun gotest-ui-read-failing-package (ui-buffer)
  "Read a failing package's state and update it in UI-BUFFER."
  (when (looking-at "^# \\(.*\\)$")
    (let* ((package (match-string 1))
           test)
      (with-current-buffer ui-buffer
        (setq test (gotest-ui-ensure-test gotest-ui--ewoc package nil :status 'fail))
        (gotest-ui-maybe-expand test)
        (gotest-ui-sort-test-into-section test nil))
      (forward-line 1)
      test)))

(defun gotest-ui-read-compiler-spew (proc process-buffer ui-buffer input)
  "Read compiler spew INPUT from PROC in PROCESS-BUFFER.

Update UI-BUFFER with the error messages."
  (with-current-buffer process-buffer
    (save-excursion
      (goto-char (point-max))
      (insert input)
      (goto-char (process-mark proc))
      (while (and (/= (point-max) (line-end-position)) ; incomplete line
                  (/= (point-max) (point)))
        (cond
         (gotest-ui--current-failing-test
          (cond
           ((looking-at "^# \\(.*\\)$")
            (gotest-ui-read-failing-package ui-buffer))
           (t
            (let* ((line (buffer-substring (point) (line-end-position)))
                   (test gotest-ui--current-failing-test))
              (forward-line 1)
              (set-marker (process-mark proc) (point))
              (with-current-buffer ui-buffer
                (gotest-ui-update-thing-output test (concat line "\n"))
                (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test)))))))
         (t
          (let ((test (gotest-ui-read-failing-package ui-buffer)))
            (setq gotest-ui--current-failing-test test)
            (set-marker (process-mark proc) (point))
            (with-current-buffer ui-buffer
              (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test))))))))))

(defun gotest-ui-read-json-1 (process-buffer marker ui-buffer input)
  "Read a chunk of json (INPUT) into PROCESS-BUFFER.

MARKER is the last end of a complete JSON object.  It is updated
if a complete json expression was read.  Update UI-BUFFER if so."
  (with-current-buffer process-buffer
    (save-excursion
      ;; insert the chunk of output at the end
      (goto-char (point-max))
      (insert input)

      ;; try to read the next object (which is hopefully complete now):
      (let ((nodes
             (cl-loop
              for (node . continue) = (gotest-ui-read-test-event process-buffer marker ui-buffer)
              when node collect node into nodes
              while continue
              finally (return nodes))))
        (when nodes
          (with-current-buffer ui-buffer
            (apply #'ewoc-invalidate gotest-ui--ewoc
                   (cl-remove-if-not (lambda (node) (marker-buffer (ewoc-location node))) (cl-remove-duplicates nodes)))))))))

(defun gotest-ui-read-test-event (process-buffer marker ui-buffer)
  "Read a test event from PROCESS-BUFFER for UI-BUFFER.

MARKER is only moved and UI-BUFFER is only updated if a complete
expression was read."
  (goto-char marker)
  (when (= (point) (line-end-position))
    (forward-line 1))
  (cl-case (char-after (point))
    (?\{
     ;; It's JSON:
     (condition-case err
         (let ((obj (json-read)))
           (set-marker marker (point))
           (with-current-buffer ui-buffer
             (cons (gotest-ui-update-test-status obj) t)))
       (json-error (cons nil nil))
       (wrong-type-argument
        (if (and (eql (cadr err) 'characterp)
                 (eql (caddr err) :json-eof))
            ;; This is peaceful & we can ignore it:
            (cons nil nil)
          (signal 'wrong-type-argument err)))))
    (?\F
     ;; It's a compiler error:
     (when (looking-at "^FAIL\t\\(.*\\)\s+\\[\\([^]]+\\)\\]\n")
       (let* ((package-name (match-string 1))
              (reason (match-string 2))
              test node)
         (with-current-buffer ui-buffer
           (setq test (gotest-ui-ensure-test gotest-ui--ewoc package-name nil :status 'fail)
                 node (gotest-ui-thing-node test))
           (setf (gotest-ui-test-reason test) reason)
           (gotest-ui-sort-test-into-section test nil)
           (gotest-ui-maybe-expand test))
         (forward-line 1)
         (set-marker marker (point))
         (cons node t))))
    (otherwise
     ;; We're done:
     (cons nil nil))))

(defun gotest-ui-maybe-expand (test)
  "Display TEST as expanded if its state is in `gotest-ui-expand-test-statuses'."
  (when (memq (gotest-ui-test-status test) gotest-ui-expand-test-statuses)
    (setf (gotest-ui-test-expanded-p test) t)))

(defun gotest-ui-update-test-status (json)
  "Update a test status from JSON."
  (let-alist json
    (let* ((action (intern .Action))
           (test (gotest-ui-ensure-test gotest-ui--ewoc .Package .Test))
           (previous-status (gotest-ui-thing-status test)))
      (cl-case action
        (run
         (gotest-ui-sort-test-into-section test nil))
        (output (gotest-ui-update-thing-output test .Output))
        (pass
         (setf (gotest-ui-thing-status test) 'pass
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (fail
         (setf (gotest-ui-thing-status test) 'fail
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (skip
         (setf (gotest-ui-thing-status test) 'skip
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (otherwise
         (setq test nil)))
      (when test (gotest-ui-thing-node test)))))

;;;; Commands for go-mode:

(defun gotest-ui--command-line (&rest cmdline)
  "Return an entire command line for invoking `go test` from CMDLINE."
  (append gotest-ui-test-binary gotest-ui-test-args gotest-ui-additional-test-args
          cmdline))

;;;###autoload
(defun gotest-ui-current-test ()
  "Launch go test with the test that (point) is in."
  (interactive)
  (cl-destructuring-bind (test-suite test-name) (go-test--get-current-test-info)
    (let ((test-flag (if (> (length test-suite) 0) "-m" "-run")))
      (when test-name
        (gotest-ui (gotest-ui--command-line test-flag (s-concat test-name "$") "."))))))

;;;###autoload
(defun gotest-ui-current-file ()
  "Launch go test on the current buffer file."
  (interactive)
  (let* ((data (go-test--get-current-file-testing-data))
         (run-flag (s-concat "-run=" data "$")))
    (gotest-ui (gotest-ui--command-line run-flag "."))))

;;;###autoload
(defun gotest-ui-current-project ()
  "Launch go test on the current buffer's project."
  (interactive)
  (let ((default-directory (projectile-project-root)))
    (gotest-ui (gotest-ui--command-line "./..."))))

(provide 'gotest-ui)

;;; gotest-ui.el ends here