Add haskell-checkers module that provides support for hs-lint and hs-…

…scan commands

This module provides support for haskell lint program (hlint) and haskell style
scanner (scan) via hs-lint and hs-scan commands, correspondingly.

Both commands are derived from compilation mode and support navigation between found
errors.

I addition, hs-lint also provides support for suggestion's replacement - this is
controlled through 2 settings, available to user

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 \

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 <alexott@gmail.com>, Liam O'Reilly <csliam@swansea.ac.uk>
+;; 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