;;; guile-shadow.el --- A Guile Flymake backend -*- lexical-binding: t; -*-

;; Apart from some questionable parts, this is based on the example in
;; the flymake manual, 2.2.2 An annotated example backend.

(defvar flymake--guile-proc nil)
(defvar flymake--guile-binary geiser-guile-binary)
(defvar flymake--guile-script (expand-file-name "~/code/guile-shadow.scm"))

(defun guile-flymake (report-fn &rest _args)
  (when (process-live-p flymake--guile-proc)
    (kill-process flymake--guile-proc))
  (let ((source (current-buffer)))
    (save-restriction
      (widen)
      (setq
       flymake--guile-proc
       (make-process
        :name "guile-flymake" :noquery t :connection-type 'pipe
        :buffer (generate-new-buffer " *guile-flymake*")
        :command `(,flymake--guile-binary "-s" ,flymake--guile-script)
        :sentinel
        (lambda (proc _event)
          (when (eq 'exit (process-status proc))
            (unwind-protect
                (if (with-current-buffer source (eq proc flymake--guile-proc))
                    (with-current-buffer (process-buffer proc)
                      (goto-char (point-min))
                      (cl-loop
                       while (search-forward-regexp "^>>> [^:]+:\\([0-9]+\\):\\([0-9]+\\): \\(.*\\)$"
                                                    nil t)
                       for line = (string-to-number (match-string 1))
                       for col  = (+ 1 (string-to-number (match-string 2)))
                       for msg  = (match-string 3)
                       for type = (if (string-match "warning" msg) :warning :error)
                       for (beg . end) = (flymake-diag-region source line col)
                       collect (flymake-make-diagnostic source beg end type msg)
                       into diags
                       finally (funcall report-fn diags)))
                  (flymake-log :warning "Cancelling obsolate check %s" proc))
              (kill-buffer (process-buffer proc))
              )))))
      (process-send-region flymake--guile-proc (point-min) (point-max))
      (process-send-eof flymake--guile-proc))))

(defun guile-setup-flymake-backend ()
  (add-hook 'flymake-diagnostic-functions 'guile-flymake nil t))

(add-hook 'scheme-mode-hook 'guile-setup-flymake-backend)