Port actionlint checker to flymake

2 files changed, 137 insertions, 24 deletions

diff --git a/tw/home/files/emacs-init.el b/tw/home/files/emacs-init.el
index de38e7a8..ddc2bb20 100644
--- a/tw/home/files/emacs-init.el
+++ b/tw/home/files/emacs-init.el
@@ -620,11 +620,13 @@ For use in `org-latex-classes'."
   (outline-minor-mode-prefix (kbd "<localleader>@") "Use localleader for `outline-minor-mode' keybindings."))
 
 ;; My own custom packages, and stuff that isn't on MELPA.
-;; (use-package actionlint   ; TODO: port to flymake
-;;   :after (flycheck)
-;;   :load-path "include/")
+(use-package actionlint
+  :after (flymake)
+  :load-path "include/"
+  :hook ((yaml-mode yaml-ts-mode) . actionlint-setup))
 
 (use-package alidist-mode
+  :after (flymake)
   :load-path "include/"
   :commands (alidist-mode)
   :mode (rx (or bot "/") "alidist/" (1+ (not ?\/)) ".sh" eot))
diff --git a/tw/home/files/emacs-packages/actionlint.el b/tw/home/files/emacs-packages/actionlint.el
index 3c37e34b..64c90bd5 100644
--- a/tw/home/files/emacs-packages/actionlint.el
+++ b/tw/home/files/emacs-packages/actionlint.el
@@ -1,4 +1,4 @@
-;;; actionlint.el --- Flycheck checker for GitHub Actions.
+;;; actionlint.el --- Flycheck checker for GitHub Actions.  -*- lexical-binding: t -*-
 ;;; Commentary:
 ;; GitHub Actions are defined using mostly plain YAML files.
 ;; Actionlint is a linter catching GitHub Action-specific mistakes, and also
@@ -6,29 +6,140 @@
 ;; pyflakes, respectively).
 ;;; Code:
 
-(require 'flycheck)
+(require 'custom)
+(require 'flymake)
+
+(defgroup actionlint nil
+  "Actionlint-related options."
+  :group 'languages
+  :prefix "actionlint-")
+
+(defcustom actionlint-executable "actionlint"
+  "The alidistlint executable to use.  This will be looked up in $PATH."
+  :type '(string)
+  :risky t
+  :group 'actionlint)
+
+(defvar actionlint--message-regexp
+  (rx bol "<stdin>:"                                              ; filename
+      (group-n 2 (+ digit)) ":"                                   ; line
+      (group-n 3 (+ digit)) ": "                                  ; column
+      (? (or (seq "pyflakes reported issue in this script: "
+                  (group-n 4 (+ digit)) ":"                       ; inner line
+                  (group-n 5 (+ digit)) " ")                      ; inner column
+             (seq "shellcheck reported issue in this script: "
+                  (group-n 8 "SC" (+ digit)) ":"                  ; shellcheck code
+                  (group-n 6 (or "info" "warning" "error")) ":"   ; type
+                  (group-n 4 (+ digit)) ":"                       ; inner line
+                  (group-n 5 (+ digit)) ": ")))                   ; inner column
+      (group-n 1 (+? not-newline)) " "                            ; message
+      "[" (group-n 7 (+ (not ?\]))) "]" eol)                      ; backend/error name
+  "Regular expression matching messages reported by actionlint.
+
+The following convention for match groups is used:
+
+  1. free-form message
+  2. outer line number
+  3. outer column number
+  4. (optional) inner line number
+  5. (optional) inner column number
+  6. (optional) error level/type
+  7. backend/error name (e.g. syntax-check or pyflakes)
+  8. (optional) backend-specific error code
+
+The outer line/column numbers are always present and refer to the location of
+the key where the error is, normally.  If the message was passed through from
+another linter (e.g. shellcheck), it may have an inner line/column, which will
+be relative to the contents of the key instead.")
+
+(defun actionlint--next-message (source)
+  "Return the next message according to REGEXP for buffer SOURCE, if any."
+  (when-let* ((match (search-forward-regexp actionlint--message-regexp nil t))
+              (inner-line (if-let ((match (match-string 4)))
+                              ;; 1-based; don't subtract 1 since we assume
+                              ;; that the script actually starts on the next
+                              ;; line.
+                              (string-to-number match)
+                            0))
+              (inner-column (if-let ((match (match-string 5)))
+                                ;; 1-based; add 1 (assuming 2-space indents)
+                                ;; to pick the right place inside the string.
+                                (1+ (string-to-number match))
+                              0))
+              (region (flymake-diag-region
+                       source
+                       (+ (string-to-number (match-string 2)) inner-line)
+                       (+ (string-to-number (match-string 3)) inner-column)))
+              (type (pcase (match-string 6)
+                      ("info" :note)
+                      ("warning" :warning)
+                      ("error" :error)
+                      ('nil :error)))
+              (message (if-let ((code (match-string 8)))
+                           (concat (match-string 1) " (" (match-string 7) " " code ")")
+                         (concat (match-string 1) " (" (match-string 7) ")"))))
+    (flymake-make-diagnostic source (car region) (cdr region) type message)))
+
+(defvar-local actionlint--flymake-proc nil
+  "The latest invocation of actionlint.")
+
+;; See info node: (flymake)An annotated example backend.
+(defun actionlint-flymake (report-fn &rest _args)
+  "Run actionlint and report diagnostics from it using REPORT-FN.
+Any running invocations are killed before running another one."
+  (unless (executable-find actionlint-executable)
+    (funcall report-fn :panic
+             :explanation "Cannot find `actionlint-executable' program")
+    (error "Cannot find actionlint executable"))
+
+  ;; Kill previous check, if it's still running.
+  (when (process-live-p actionlint--flymake-proc)
+    (kill-process actionlint--flymake-proc))
+
+  ;; This needs `lexical-binding'.
+  (let ((source (current-buffer)))
+    (save-restriction
+      (widen)
+      (setq actionlint--flymake-proc
+            (make-process
+             :name "actionlint-flymake" :noquery t :connection-type 'pipe
+             ;; Direct output to a temporary buffer.
+             :buffer (generate-new-buffer " *actionlint-flymake*")
+             :command (list actionlint-executable "-oneline" "-no-color" "-")
+             :sentinel
+             (lambda (proc _event)
+               "Parse diagnostic messages once the process PROC has exited."
+               ;; Check the process has actually exited, not just been suspended.
+               (when (memq (process-status proc) '(exit signal))
+                 (unwind-protect
+                     ;; Only proceed if we've got the "latest" process.
+                     (if (with-current-buffer source (eq proc actionlint--flymake-proc))
+                         (with-current-buffer (process-buffer proc)
+                           (goto-char (point-min))
+                           (cl-do (diags
+                                   (msg (actionlint--next-message source)
+                                        (actionlint--next-message source)))
+                               ((null msg)
+                                (funcall report-fn diags))
+                             (push msg diags)))
+                       (flymake-log :warning "Canceling obsolete check %s" proc))
+                   ;; Clean up temporary buffer.
+                   (kill-buffer (process-buffer proc)))))))
+      ;; Send the buffer to actionlint on stdin.
+      (process-send-region actionlint--flymake-proc (point-min) (point-max))
+      (process-send-eof actionlint--flymake-proc))))
 
 (defun actionlint-github-workflow-p ()
   "Does the current buffer contain a GitHub Action?"
-  (string-match-p "\\.github/workflows/[^/]+\\.yml\\'" (buffer-file-name)))
-
-(flycheck-def-executable-var actionlint "actionlint")
-
-(flycheck-define-checker actionlint
-  "A syntax checker and linter for alidist recipes."
-  ;; `flycheck-alidist-executable' automatically overrides the car of the
-  ;; :command list if set and non-nil.
-  :command ("actionlint" "-no-color" "-oneline" source)
-  :error-patterns
-  ((error line-start (file-name) ":" line ":" column ": " (message)
-          " [" (id (minimal-match (one-or-more not-newline))) "]" line-end))
-  ;; Only enable this in actual GitHub Actions, not just any YAML document.
-  :modes (yaml-mode)
-  :predicate actionlint-github-workflow-p
-  ;; Also check the document with YAML checkers, whether or not we have errors.
-  :next-checkers (yaml-ruby yaml-yamllint))
-
-(add-to-list 'flycheck-checkers 'actionlint)
+  (string-match-p (rx ".github/workflows/" (+ (not ?\/)) ".yml" eos) (buffer-file-name)))
+
+(defun actionlint-setup ()
+  "Set up actionlint in this buffer, if it is recognised as a workflow file."
+  (when (actionlint-github-workflow-p)
+    (add-hook 'flymake-diagnostic-functions #'actionlint-flymake nil t)))
+
+(add-hook 'yaml-mode-hook #'actionlint-setup)
+(add-hook 'yaml-ts-mode-hook #'actionlint-setup)
 
 (provide 'actionlint)
 ;;; actionlint.el ends here