[nongnu] elpa/flymake-collection 95c3a3ff3b 02/89: (flymake-rest): Add macro for checker definition

[ELPA Syncer]

branch: elpa/flymake-collection
commit 95c3a3ff3bf1fb0486794bbe5880d99eabb6eb06
Author: Mohsin Kaleem <mohkale@kisara.moe>
Commit: Mohsin Kaleem <mohkale@kisara.moe>

    (flymake-rest): Add macro for checker definition
---
 flymake-rest-define.el    | 229 ++++++++++++++++++++++++++++++++++++++++++++++
 flymake-rest-enumerate.el |  31 +++++++
 flymake-rest-rx.el        | 115 +++++++++++++++++++++++
 flymake-rest.el           |  65 +++++++++++++
 4 files changed, 440 insertions(+)

diff --git a/flymake-rest-define.el b/flymake-rest-define.el
new file mode 100644
index 0000000000..c5b184d217
--- /dev/null
+++ b/flymake-rest-define.el
@@ -0,0 +1,229 @@
+;;; flymake-rest-define.el --- A macro to simplify checker creation -*- 
lexical-binding: t -*-
+
+;;; Commentary:
+
+;; This file provides a macro, adapted heavily from 
[[https://github.com/karlotness/flymake-quickdef/blob/150c5839768a3d32f988f9dc08052978a68f2ad7/flymake-quickdef.el][flymake-quickdef]],
+;;
+;; A shallow fork of 
[[https://github.com/karlotness/flymake-quickdef][flymake-quickdef]] supporting 
more flycheck like features.
+;; TODO: Finish
+
+;; TODO: license
+
+;;; Code:
+
+(require 'flymake)
+
+;;;###autoload
+(defvar-local flymake-rest-define--procs nil)
+
+(defmacro flymake-rest-define (name &optional docstring &rest defs)
+  "Quickly define a backend for use with Flymake.
+This macro creates a new function NAME which is suitable for use with the
+variable `flymake-diagnostic-functions'.
+
+DEFS is a plist of values used to setup the backend. The only required fields
+in DEFS is :command and :error-parser.
+
+Available Variables
+
+fmqd-source, fmqd-temp-file, fmdq-temp-dir, fmqd-context. TODO: Document.
+
+Body Definitions
+
+The overall execution of the produced function first makes use of (1)
+:write-type, (2) :source-inplace, (3) :pre-let, and (3) :pre-check. Next
+a process is created using (4) :command. Once the process is finished
+:error-parser is called (until it returns nil) to get the next diagnostic
+which is then provided to flymake. (5) :title if provided is used to
+suffix the messages for each diagnostic.
+
+:write-type specifies how the process for flymake should recieve the input.
+It should be one of 'pipe or 'file (defaulting to 'pipe). When set to file
+a temporary file will be created copying the contents of the current-buffer.
+The variable fmqd-temp-file and fmqd-temp-dir will be bound in the body
+of the rest of the keywords that provide access to the temp-file. When set
+to pipe after the process has been started all of the current buffers input
+will be passed to the process through standard-input.
+
+:source-inplace is a boolean that sets fmqd-temp-dir to the current working
+directory. By default this is nil and the temp-file used for :write-type 'file
+will be set to a folder in the systems temporary directory.
+
+:pre-let is a `let*' form that is assigned after any backend-agnostic let
+forms have been setup.
+
+:pre-check is a lisp form that will be executed immeadiately before any pending
+checker processes are killed and a new process is begun. It can check 
conditions
+to ensure launching the checker program is possible. If something is wrong it
+should signal an error.
+
+:command is a lip form which evaluates to a list of strings that will be used 
to
+start the checker process. It should be suitable for use as the :command 
argument
+to the `make-process' function.
+
+:error-parser is a lisp-form that should, each time it is evaluated, return the
+next diagnostic from the checker output. The result should be a value that can
+be passed to the `flymake-make-diagnostic' function. Once there're no more
+diagnostics to parse this form should evaluate to nil."
+  (declare (indent defun) (doc-string 2))
+  (unless lexical-binding
+    (error "Need lexical-binding for flymake-rest-define (%s)" name))
+  (or (stringp docstring)
+      (setq defs (cons docstring defs)
+            docstring nil))
+  (dolist (elem '(:command :error-parser))
+    (unless (plist-get defs elem)
+      (error "Missing flymake backend definition `%s'" elem)))
+  (let* ((write-type (or (eval (plist-get defs :write-type)) 'pipe))
+         (source-inplace (plist-get defs :source-inplace))
+         (temp-dir-symb (intern "fmqd-temp-dir"))
+         (temp-file-symb (intern "fmqd-temp-file"))
+         (err-symb (intern "fmqd-err"))
+         (diags-symb (intern "diags"))
+         (proc-symb (intern "proc"))
+         (source-symb (intern "fmqd-source"))
+         (current-diags-symb (intern "diag"))
+         (cleanup-form (when (and (eq write-type 'file)
+                                  (not source-inplace))
+                         `((delete-directory ,temp-dir-symb t))))
+         (not-obsolete-form `((eq ,proc-symb (plist-get (buffer-local-value 
'flymake-rest-define--procs ,source-symb) ',name)))))
+    ;; Sanitise parsed inputs from `defs'.
+    (unless (memq write-type '(file pipe nil))
+      (error "Invalid `:write-type' value `%s'" write-type))
+
+    `(defun ,name (report-fn &rest _args)
+       ,docstring
+       (let* ((,source-symb (current-buffer))
+              (fmqd-context nil)
+              ,@(when (eq write-type 'file)
+                  `((,temp-dir-symb
+                     ,@(let ((forms (append (when source-inplace
+                                              `((when-let ((file 
(buffer-file-name)))
+                                                  (file-name-directory file))
+                                                default-directory))
+                                            '((make-temp-file "flymake-" t)))))
+                         (if (> (length forms) 1)
+                             `((or ,@forms))
+                           forms)))
+                    (,temp-file-symb
+                     (concat
+                      (file-name-as-directory ,temp-dir-symb)
+                      (concat ".flymake_"
+                              (file-name-nondirectory (or (buffer-file-name)
+                                                          (buffer-name))))))))
+              ,@(plist-get defs :pre-let))
+         ;; With vars defined, do :pre-check.
+         ,@(when-let ((pre-check (plist-get defs :pre-check)))
+             `((condition-case ,err-symb
+                   (progn ,pre-check)
+                 (error ,@cleanup-form
+                        (signal (car ,err-symb) (cdr ,err-symb))))))
+         ;; Kill any running (obsolete) processes for current checker and 
buffer.
+         (let ((,proc-symb (plist-get flymake-rest-define--procs ',name)))
+           (when (process-live-p ,proc-symb)
+             (kill-process ,proc-symb)
+             (flymake-log :debug "Killing earlier checker process %s" 
,proc-symb)))
+
+         ;; Kick-start checker process.
+         (save-restriction
+           (widen)
+           ;; Write the current file out before starting checker.
+           ,@(when (eq write-type 'file)
+               `((write-region nil nil ,temp-file-symb nil 'silent)))
+           (let (proc)
+             (setq proc
+                   (make-process
+                    :name ,(concat (symbol-name name) "-flymake")
+                    :noquery t
+                    :connection-type 'pipe
+                    :buffer (generate-new-buffer ,(concat " *" (symbol-name 
name) "-flymake*"))
+                    :command
+                    (let ((cmd ,(plist-get defs :command)))
+                      (prog1 cmd
+                        (flymake-log :debug "Checker command is %s" cmd)))
+                    :sentinel
+                    (lambda (,proc-symb _event)
+                      (unless (process-live-p ,proc-symb)
+                        (unwind-protect
+                            (if ,@not-obsolete-form
+                                (with-current-buffer ,source-symb
+                                  ;; First read diagnostics from process 
buffer referencing the source buffer.
+                                  (let ((,diags-symb nil) ,current-diags-symb)
+                                    ;; Widen the source buffer to ensure 
`flymake-diag-region' is correct.
+                                    (save-restriction
+                                      (widen)
+                                      (with-current-buffer (process-buffer 
,proc-symb)
+                                        (goto-char (point-min))
+                                        (save-match-data
+                                          (while (setq ,current-diags-symb 
,(plist-get defs :error-parser))
+                                            (let* ((diag-beg (nth 1 
,current-diags-symb))
+                                                   (diag-end (nth 2 
,current-diags-symb))
+                                                   (diag-type (nth 3 
,current-diags-symb)))
+                                              (if (and (integer-or-marker-p 
diag-beg)
+                                                       (integer-or-marker-p 
diag-end))
+                                                  ;; Skip any diagnostics with 
a type of nil
+                                                  ;; This makes it easier to 
filter some out.
+                                                  (when diag-type
+                                                    ;; Include the checker 
name/title in the message.
+                                                    ,@(when (plist-get defs 
:title)
+                                                        `((setf (nth 4 
,current-diags-symb)
+                                                                (concat (nth 4 
,current-diags-symb)
+                                                                        
,(concat
+                                                                          " ("
+                                                                          
(propertize (plist-get defs :title)
+                                                                               
       'face 'flymake-rest-checker)
+                                                                          
")")))))
+
+                                                    (push (apply 
#'flymake-make-diagnostic ,current-diags-symb)
+                                                          ,diags-symb))
+                                                (with-current-buffer 
,source-symb
+                                                  (flymake-log :error "Got 
invalid buffer position %s or %s in %s"
+                                                               diag-beg 
diag-end ,proc-symb))))))))
+                                    ;; Pass reports back to the 
callback-function when still not-obsolete.
+                                    (if ,@not-obsolete-form
+                                        (progn
+                                          (let ((status (process-exit-status 
,proc-symb)))
+                                            (when (and (eq (length 
,diags-symb) 0)
+                                                       (not (eq status 0)))
+                                              (flymake-log :warning
+                                                           "Checker gave no 
diagnostics but had a non-zero exit status %d\nStderr:" status
+                                                           
(with-current-buffer (process-buffer ,proc-symb)
+                                                             (format "%s" 
(buffer-substring-no-properties
+                                                                           
(point-min) (point-max)))))))
+                                          (funcall report-fn (nreverse 
,diags-symb)))
+                                      ;; In case the check was cancelled after 
processing began but before it finished.
+                                      (flymake-log :warning "Canceling 
obsolete check %s" ,proc-symb)))
+                                  (flymake-log :warning "Canceling obsolete 
check %s" ,proc-symb)))
+                          ;; Finished linting, cleanup any temp-files and then 
kill proc buffer.
+                          ,@cleanup-form
+                          (kill-buffer (process-buffer ,proc-symb)))))))
+             ;; Push the new-process to the process to the process alist.
+             (setq flymake-rest-define--procs
+                   (plist-put flymake-rest-define--procs ',name ,proc-symb))
+             ;; If piping, send data to the process.
+             ,@(when (eq write-type 'pipe)
+                 `((process-send-region proc (point-min) (point-max))
+                   (process-send-eof proc)))
+             ,proc-symb))))))
+
+(defun flymake-rest-parse-json (output)
+  "Helper for `flymake-rest-define' to parse JSON output OUTPUT.
+
+Adapted from `flycheck-parse-json'. This reads a bunch of JSON-Lines
+like output from OUTPUT into a list and then returns it."
+  (let (objects
+        (json-array-type 'list)
+        (json-false nil))
+    (with-temp-buffer
+      (insert output)
+      (goto-char (point-min))
+      (while (not (eobp))
+        (when (memq (char-after) '(?\{ ?\[))
+          (push (json-parse-buffer
+                 :object-type 'alist :array-type 'list
+                 :null-object nil :false-object nil)
+                objects))
+        (forward-line)))
+    objects))
+
+(provide 'flymake-rest-define)
diff --git a/flymake-rest-enumerate.el b/flymake-rest-enumerate.el
new file mode 100644
index 0000000000..964fac8447
--- /dev/null
+++ b/flymake-rest-enumerate.el
@@ -0,0 +1,31 @@
+;;; flymakflymake-backend-parse-enumerate!to simplify checker creation -*- 
lexical-binding: t -*-
+
+;;; Commentary:
+;; TODO
+;; TODO: license
+
+;;; Code:
+
+(defmacro flymake-rest-parse-enumerate (gen &rest body)
+  "Error parser for `flymake-backend-define' which parses all of
+the diagnostics at once using GEN and then preparing them one-at-a-time
+with BODY.
+
+The value of the current entry from GEN in BODY will be set to the variable
+`it'. BODY should evaluate to a form that can be passed to
+`flymake-make-diagnostic'."
+  (declare (indent 1))
+  (let ((context-var (intern "fmqd-context")))
+    `(progn
+       (unless (alist-get 'enumerated ,context-var)
+         (push (cons 'entries ,gen) ,context-var)
+         (push '(enumerated t) ,context-var))
+       (let (it res)
+         ;; While we haven't found a new diagnostic to return, BUT there're
+         ;; still diagnostics that can be found in the parsed checker output.
+         (while (and (not res)
+                     (setq it (pop (alist-get 'entries ,context-var))))
+           (setq res ,@body))
+         res))))
+
+(provide 'flymake-rest-enumerate)
diff --git a/flymake-rest-rx.el b/flymake-rest-rx.el
new file mode 100644
index 0000000000..7f14291432
--- /dev/null
+++ b/flymake-rest-rx.el
@@ -0,0 +1,115 @@
+;;; flymake-rest-rest.el --- A macro to simplify checker creation -*- 
lexical-binding: t -*-
+
+;;; Commentary:
+;; TODO
+;; TODO: license
+
+;;; Code:
+
+(defconst flymake-rest-rx-constituents
+  `((file-name ,(lambda (body)
+                  (rx-to-string
+                   `(group-n 1 ,@(or (cdr body)
+                                     '((minimal-match
+                                        (one-or-more not-newline)))))
+                   t))
+               0 nil) ;; group 1
+    (line . ,(rx (group-n 2 (one-or-more digit))))
+    (column . ,(rx (group-n 3 (one-or-more digit))))
+    (message ,(lambda (body)
+                (rx-to-string
+                 `(group-n 4 ,@(or (cdr body)
+                                   '((minimal-match
+                                      (one-or-more not-newline)))))
+                 t))
+             0 nil)
+    (id ,(lambda (body)
+           (rx-to-string `(group-n 5 ,@(cdr body)) t))
+        0 nil)
+    (end-line . ,(rx (group-n 6 (one-or-more digit))))
+    (end-column . ,(rx (group-n 7 (one-or-more digit))))))
+
+(defmacro flymake-rest-parse-rx (regexps)
+  "Helper for `flymake-rest-define' which tries to emulate flychecks
+:error-parsers.
+
+This macro generates a parser that for each line of output from the
+checker process, runs one or more REGEXPs on it and then converts the
+result to a valid flymake diagnostic (that can be passed back to
+`flymake-make-diagnostic').
+
+TODO: describe arguments.
+"
+  (unless (> (length regexps) 0)
+    (error "Must supply at least one regexp for error, warning or note"))
+  ;; To avoid having to rematch each diagnostic more than once we append
+  ;; a special extra capture group (greater than all the ones above) that
+  ;; simply matches the empty string. Then we can index the groups after
+  ;; 7 and use that to determine the severity of the symbol.
+  (setq regexps
+        (cl-loop for (severity . regex) in regexps
+                 with count = 7
+                 do (setq count (1+ count))
+                 collect (cons `(seq ,@regex (group-n ,count ""))
+                               (intern (concat ":" (symbol-name severity))))))
+
+  (let ((combined-regex
+         (let ((rx-constituents (append flymake-rest-rx-constituents
+                                        rx-constituents nil)))
+           (rx-to-string `(or ,@(mapcar #'car regexps))
+                         'no-group)))
+        (severity-seq (mapcar #'cdr regexps)))
+    ;; Because if this evaluates to nil `flymake-rest-define' thinks there
+    ;; are no-more diagnostics to be parsed, we wrap it in a loop that exits
+    ;; the moment we find a match, but otherwise keeps moving through 
diagnostics
+    ;; until there actually aren't any more to match.
+    `(let (res
+           file-name line column message id end-line end-column severity-ix)
+       (while (and (not res)
+                   (search-forward-regexp ,combined-regex nil t))
+         (setq
+          res
+          (save-match-data
+            (save-excursion
+              (setq file-name (match-string 1)
+                    line (match-string 2)
+                    column (match-string 3)
+                    message (match-string 4)
+                    id (match-string 5)
+                    end-line (match-string 6)
+                    end-column (match-string 7)
+                    severity-ix (seq-find #'match-string
+                                          (number-sequence 0 ,(- (length 
regexps) 1))))
+              (cond
+               ;; Log an error when any of the required fields are missing.
+               ,@(cl-loop for it in '(severity-ix line message)
+                          collect
+                          `((not ,it)
+                            (flymake-log :error
+                                         ,(format
+                                           "Matched diagnostic didn't capture 
a %s group"
+                                           (symbol-name it)))
+                            nil))
+               (t
+                (let ((loc (flymake-diag-region fmqd-source
+                                                (string-to-number line)
+                                                (when column
+                                                  (string-to-number column))))
+                      (loc-end (when end-line
+                                 (flymake-diag-region fmqd-source
+                                                      (string-to-number 
end-line)
+                                                      (when end-column
+                                                        (string-to-number 
end-column))))))
+                  (when loc-end
+                    (setcdr loc (cdr loc-end)))
+                  (list fmqd-source
+                        (car loc)
+                        (cdr loc)
+                        (nth severity-ix (quote ,severity-seq))
+                        (concat
+                         (when id
+                           (concat (propertize id 'face 'flymake-diag-id!) " 
"))
+                         message)))))))))
+       res)))
+
+(provide 'flymake-rest-rx)
diff --git a/flymake-rest.el b/flymake-rest.el
new file mode 100644
index 0000000000..588ba88b8c
--- /dev/null
+++ b/flymake-rest.el
@@ -0,0 +1,65 @@
+;;; flymake-rest.el --- Core features for flymake-rest -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2021 Mohsin Kaleem
+
+;; Author: Mohsin Kaleem <mohkale@kisara.moe>
+;; Created: 15 June 2021
+;; Homepage: https://github.com/mohkale/flymake-rest
+;; Keywords: language tools
+;; Package-Requires: ((emacs "26.1") (flymake "1"))
+;; SPDX-License-Identifier: MIT
+;; Version: 3.1
+
+;; Copyright (c) 2021 Mohsin Kaleem
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to 
deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in 
all
+;; copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 
FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
THE
+;; SOFTWARE.
+
+;;; Commentary:
+
+;; flymake-rest is a helper for migrating from flycheck to flymake.
+;;
+;; This includes the definition of several diagnostic functions, hooks
+;; to specify the precedence and preferred order of them and the means
+;; to easily configure flymake linting.
+;;
+;; For more see [[file:README.org][README.org]].
+
+;; Please see https://github.com/mohkale/flymake-rest for more
+;; information.
+
+;;; Code:
+
+(defgroup flymake-rest nil
+  "Flymake flycheck compatibility"
+  :prefix "flymake-rest")
+
+(defgroup consult-faces nil
+  "Faces used by flymake-rest."
+  :group 'flymake-rest
+  :group 'faces)
+
+(defface flymake-rest-checker
+  '((t (:inherit (dired-directory bold))))
+  "Title of a checker as shown in the diagnostic message.")
+
+(defface flymake-rest-diag-id
+  '((t (:inherit font-lock-type-face)))
+  "Id of a diagnostic.")
+
+(provide 'flymake-rest)