;;; flymake-guile.el --- Flymake checker using `guild compile'  -*- lexical-binding: t -*-
;;; Commentary:
;;; "guild compile" compiles Guile code to bytecode and can output a few basic
;;; warnings.  Let's use this as a linter!
;;; Code:

(require 'custom)
(require 'flymake)
(require 'geiser-impl)   ; for `geiser-active-implementations'

(defcustom flymake-guile-guild-executable "guild"
  "The guild executable to use.  This will be looked up in $PATH."
  :type '(string)
  :risky t
  :group 'flymake-guile)

(defvar-local flymake-guile--flymake-proc nil
  "The latest invocation of guild compile.")

(defvar-local flymake-guile--temp-file nil
  "The temporary file name to pass to guild.")

(defun flymake-guile--encode-filename (buffer-name)
  "Create a safe temporary file name from BUFFER-NAME."
  (concat "/tmp/flymake-guile-"
          (string-replace
           "/" "!"   ; we don't want to create subdirs under /tmp
           (or buffer-name
               (format "temp-%s.scm"
                       (random most-positive-fixnum))))))

;; See info node: (flymake)An annotated example backend.
(defun flymake-guile (report-fn &rest _args)
  "Run guild compile and report diagnostics from it using REPORT-FN.
Any running invocations are killed before running another one."
  (unless (executable-find flymake-guile-guild-executable)
    (funcall report-fn :panic
             :explanation "Cannot find `flymake-guile-guild-executable' program")
    (error "Cannot find guild executable"))

  (unless flymake-guile--temp-file
    (setq-local flymake-guile--temp-file (flymake-guile--encode-filename (buffer-file-name))))

  ;; Kill previous check, if it's still running.
  (when (process-live-p flymake-guile--flymake-proc)
    (kill-process flymake-guile--flymake-proc))

  ;; This needs `lexical-binding'.
  (let ((source (current-buffer))
        ;; Copy `flymake-guile--temp-file' to a local var so that we can refer to it in the `lambda' below.
        (temp-file flymake-guile--temp-file))
    (save-restriction
      (widen)
      ;; Send the buffer to guild on stdin.
      (with-temp-file flymake-guile--temp-file
        (insert-buffer-substring-no-properties source))
      (setq flymake-guile--flymake-proc
            (make-process
             :name "flymake-guild" :noquery t :connection-type 'pipe
             ;; Direct output to a temporary buffer.
             :buffer (generate-new-buffer " *flymake-guile*")
             ;; Guild can't read from stdin; it needs a file.
             :command (list flymake-guile-guild-executable "compile"
                            ;; See "guild --warn=help" for details.
                            ;; "--warn=unsupported-warning"  ; ignore unsupported warning types
                            ;; "--warn=unused-variable"  ; too many false positives from macros
                            "--warn=unused-toplevel"
                            "--warn=shadowed-toplevel"
                            "--warn=unbound-variable"
                            "--warn=macro-use-before-definition"
                            "--warn=use-before-definition"
                            "--warn=non-idempotent-definition"
                            "--warn=arity-mismatch"
                            "--warn=duplicate-case-datum"
                            "--warn=bad-case-datum"
                            "--warn=format"
                            "-L" (expand-file-name
                                  (project-root (project-current nil (file-name-directory
                                                                      (buffer-file-name source)))))
                            flymake-guile--temp-file)
             :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 (not (eq proc flymake-guile--flymake-proc)))
                         (flymake-log :warning "Canceling obsolete check %s" proc)
                       (with-current-buffer (process-buffer proc)
                         (goto-char (point-min))
                         (cl-loop
                          with msg-regexp = (rx bol (literal temp-file) ":"          ; filename
                                                (group (+ digit)) ":"                ; line
                                                (group (+ digit)) ": "               ; column
                                                (group (or "warning" "error")) ": "  ; type
                                                (group (+ not-newline)) eol)         ; message
                          while (search-forward-regexp msg-regexp nil t)
                          for (beg . end) = (flymake-diag-region
                                             source   ; we filter for messages matching our buffer in the regexp
                                             (string-to-number (match-string 1))
                                             ;; guild outputs 0-based column numbers
                                             (1+ (string-to-number (match-string 2))))
                          for type = (pcase (match-string 3)
                                       ("warning" :warning)
                                       ("error" :error)
                                       (type (error "Unknown guild error type %s" type)))
                          collect (flymake-make-diagnostic source beg end type (match-string 4))
                          into diags
                          finally (funcall report-fn diags))))
                   ;; Clean up temporary buffer.
                   (kill-buffer (process-buffer proc))
                   (delete-file temp-file)))))))))

(defun flymake-guile-enable ()
  "Set up the Guile checker for flymake, if in a Guile buffer."
  (when (memq 'guile geiser-active-implementations)
    (add-hook 'flymake-diagnostic-functions #'flymake-guile nil t)))

(add-hook 'scheme-mode-hook #'flymake-guile-enable)

(provide 'flymake-guile)
;;; flymake-guile.el ends here