diff --git a/Makefile b/Makefile index f4db6e8d6..27ca3d6b8 100644 --- a/Makefile +++ b/Makefile @@ -10,6 +10,7 @@ ELFILES = \ haskell-hugs.el \ haskell-indent.el \ haskell-indentation.el \ + haskell-checkers.el \ haskell-mode.el \ haskell-simple-indent.el \ ghc-core.el \ diff --git a/haskell-checkers.el b/haskell-checkers.el new file mode 100644 index 000000000..b716530a1 --- /dev/null +++ b/haskell-checkers.el @@ -0,0 +1,158 @@ +;;; haskell-checkers.el --- Emacs interface to haskell lint and style checkers + +;; Copyright 2009-2011 (c) Alex Ott, Liam O'Reilly +;; +;; Author: Alex Ott , Liam O'Reilly +;; Keywords: haskell, lint, hlint, style scanner +;; Requirements: hlint, scan, haskell +;; Status: distributed under terms of GPL2 or above + +(require 'compile) + +(defgroup haskell-checkers nil + "Run HLint as inferior of Emacs, parse error messages." + :group 'tools + :group 'haskell) + +(defcustom hs-lint-command "hlint" + "The default lint command for \\[hlint]." + :type 'string + :group 'haskell-checkers) + +(defcustom hs-scan-command "scan" + "The default scan command for \\[hs-scan]." + :type 'string + :group 'haskell-checkers) + +(defcustom hs-scan-options "" + "The default options for \\[hs-scan]." + :type 'string + :group 'haskell-checkers) + +(defcustom hs-lint-options "" + "The default options for \\[hlint]." + :type 'string + :group 'haskell-checkers) + +(defcustom hs-checkers-save-files t + "Save modified files when run checker or not (ask user)" + :type 'boolean + :group 'haskell-checkers) + +(defcustom hs-checkers-replace-with-suggestions nil + "Replace user's code with suggested replacements (hlint only)" + :type 'boolean + :group 'haskell-checkers) + +(defcustom hs-checkers-replace-without-ask nil + "Replace user's code with suggested replacements automatically (hlint only)" + :type 'boolean + :group 'haskell-checkers) + +;; regex for replace HLint's suggestions +;; +;; ^\(.*?\):\([0-9]+\):\([0-9]+\): .* +;; Found: +;; \s +\(.*\) +;; Why not: +;; \s +\(.*\) + +(defvar hs-lint-regex + "^\\(.*?\\):\\([0-9]+\\):\\([0-9]+\\): .*[\n\C-m]Found:[\n\C-m]\\s +\\(.*\\)[\n\C-m]Why not:[\n\C-m]\\s +\\(.*\\)[\n\C-m]" + "Regex for HLint messages") + +(defun hs-checkers-make-short-string (str maxlen) + (if (< (length str) maxlen) + str + (concat (substring str 0 (- maxlen 3)) "..."))) + +;; TODO: check, is it possible to adopt it for hs-scan? +(defun hs-lint-replace-suggestions () + "Perform actual replacement of HLint's suggestions" + (goto-char (point-min)) + (while (re-search-forward hs-lint-regex nil t) + (let* ((fname (match-string 1)) + (fline (string-to-number (match-string 2))) + (old-code (match-string 4)) + (new-code (match-string 5)) + (msg (concat "Replace '" (hs-checkers-make-short-string old-code 30) + "' with '" (hs-checkers-make-short-string new-code 30) "'")) + (bline 0) + (eline 0) + (spos 0) + (new-old-code "")) + (save-excursion + (switch-to-buffer (get-file-buffer fname)) + (goto-line fline) + (beginning-of-line) + (setf bline (point)) + (when (or hs-checkers-replace-without-ask + (yes-or-no-p msg)) + (end-of-line) + (setf eline (point)) + (beginning-of-line) + (setf old-code (regexp-quote old-code)) + (while (string-match "\\\\ " old-code spos) + (setf new-old-code (concat new-old-code + (substring old-code spos (match-beginning 0)) + "\\ *")) + (setf spos (match-end 0))) + (setf new-old-code (concat new-old-code (substring old-code spos))) + (remove-text-properties bline eline '(composition nil)) + (when (re-search-forward new-old-code eline t) + (replace-match new-code nil t))))))) + +(defun hs-lint-finish-hook (buf msg) + "Function, that is executed at the end of HLint or scan execution" + (if hs-checkers-replace-with-suggestions + (hs-lint-replace-suggestions) + (next-error 1 t))) + +(defun hs-scan-finish-hook (buf msg) + "Function, that is executed at the end of hs-scan execution" + (next-error 1 t)) + +(defun hs-scan-make-command (file) + "Generates command line for scan" + (concat hs-scan-command " " hs-scan-options " \"" file "\"")) + +(defun hs-lint-make-command (file) + "Generates command line for scan" + (concat hs-lint-command " \"" file "\"" " " hs-lint-options)) + +(defmacro hs-checkers-setup (type name) + "Performs setup of corresponding checker. Receives two arguments: +type - checker's type (lint or scan) that is expanded into functions and hooks names +name - user visible name for this mode" + (let ((nm (concat "hs-" (symbol-name type)))) + `(progn +;;;###autoload + (defvar ,(intern (concat nm "-setup-hook")) nil + ,(concat "Hook, that will executed before running " name)) + (defun ,(intern (concat nm "-process-setup")) () + "Setup compilation variables and buffer for `hlint'." + (run-hooks ',(intern (concat nm "-setup-hook")))) +;;;###autoload + (define-compilation-mode ,(intern (concat nm "-mode")) ,name + ,(concat "Mode to check Haskell source code using " name) + (set (make-local-variable 'compilation-process-setup-function) + ',(intern (concat nm "-process-setup"))) + (set (make-local-variable 'compilation-disable-input) t) + (set (make-local-variable 'compilation-scroll-output) nil) + (set (make-local-variable 'compilation-finish-functions) + (list ',(intern (concat nm "-finish-hook"))))) +;;;###autoload + (defun ,(intern nm) () + ,(concat "Run " name " for current buffer with haskell source") + (interactive) + (save-some-buffers hs-checkers-save-files) + (compilation-start (,(intern (concat nm "-make-command")) buffer-file-name) + ',(intern (concat nm "-mode"))))) + )) + +(hs-checkers-setup lint "HLint") +(hs-checkers-setup scan "HScan") + +(provide 'haskell-checkers) + +;;; haskell-checkers.el ends here