(require 'flymake)

(require 'flymake-collection)

(require 'project)

(eval-when-compile (require 'flymake-collection-define))

(defgroup flymake-rakudo nil

"Rakudo (Raku implementation) support for Flymake."

:prefix "flymake-rakudo-"

:group 'flymake

:link '(url-link :tag "Github" "https://github.com/Raku/flymake-rakudo"))

(defcustom flymake-rakudo-include-path nil

"A list of include directories for Raku.

:type '(repeat (directory :tag "Include directory")))

(defun flymake-rakudo--find-elements-with-line (alist)

"Return elements of ALIST which contain .line."

(cl-loop for element in alist

if (nested-alist-p element)

if (assq 'line element) return (list element)

else append (flymake-rakudo--find-elements-with-line element)))

(defun flymake-rakudo--parse-panic (panic)

"Parse PANIC field from JSON."

(if (string-match "\\`\\(Undeclared \\(?:routine\\|name\\)\\)s?:" panic)

(let ((error-type (match-string 1 panic)) errs)

(while (string-match "\s*\\(.+?\\) at lines? \\([^\n]+\n\\)" panic (match-end 0))

(let ((msg (concat error-type " " (match-string 1 panic)))

(rest-of-line (match-string 2 panic))

(rest-start-pos 0)

line-numbers)

(save-match-data

(while (string-match "\\([[:digit:]]+\\)\\(?:, \\)?" rest-of-line rest-start-pos)

(setq rest-start-pos (match-end 0))

(push (string-to-number (match-string 1 rest-of-line))

line-numbers))

(string-match "\\([^\n]*\\)\n" rest-of-line (match-end 0))

(mapc

(lambda (line-number)

(push

`(panic . ((line . ,line-number) (message . ,(concat msg (match-string 1 rest-of-line)))))

errs))

line-numbers))))

errs)))

(flymake-collection-define-enumerate flymake-rakudo

"A Raku syntax checker."

:title "Rakudo"

:pre-let ((rakudo-exec (executable-find "rakudo"))

(_env-var (progn

(make-local-variable 'process-environment)

(setenv "RAKU_EXCEPTIONS_HANDLER" "JSON"))))

:pre-check (unless rakudo-exec

(error "Cannot find rakudo executable"))

:write-type 'pipe

:command `(,rakudo-exec

"-c"

,@(let ((include-paths flymake-rakudo-include-path))

;; Add project root to path

(let ((current-project (project-current)))

(if current-project

(push (expand-file-name (project-root current-project))

include-paths)))

(cl-loop for path in include-paths

collect (concat "-I" path))))

:generator

(let ((json-alist

(flymake-collection-parse-json

(buffer-substring-no-properties

(point-min) (point-max)))))

(let ((errors (flymake-rakudo--find-elements-with-line json-alist)))

(let-alist (cdaar json-alist)

(when .panic

(setq errors (append errors (flymake-rakudo--parse-panic .panic)))))

errors))

:enumerate-parser

(let-alist it

(let (column expected)

(if .pos

(with-current-buffer flymake-collection-source

(setq column (save-excursion (goto-char .pos) (current-column)))))

(if .highexpect

(let ((padded_expect (mapconcat (lambda (str) (concat " " str)) .highexpect "\n")))

(setq expected (concat "\nexpecting any of:\n" padded_expect))))

(let ((loc (flymake-diag-region flymake-collection-source .line column))

(message (concat

(propertize (symbol-name (car it)) 'face 'flymake-collection-diag-id)

"\n"

.message

expected)))

(list flymake-collection-source (car loc) (cdr loc) :error message)))))

(defun flymake-rakudo-setup ()

"Add `flymake-rakudo' to `flymake-diagnostic-functions'."

(interactive)

(add-hook 'flymake-diagnostic-functions #'flymake-rakudo nil t))

(provide 'flymake-rakudo)