hs-lint/hs-lint.el

   1 ;;; hs-lint.el --- minor mode for HLint code checking
   2
   3 ;; Copyright 2009 (C) Alex Ott
   4 ;;
   5 ;; Author: Alex Ott <alexott@gmail.com>
   6 ;; Keywords: haskell, lint, HLint
   7 ;; Requirements:
   8 ;; Status: distributed under terms of GPL2 or above
   9
  10 ;; Typical message from HLint looks like:
  11 ;;
  12 ;; /Users/ott/projects/lang-exp/haskell/test.hs:52:1: Eta reduce
  13 ;; Found:
  14 ;;   count1 p l = length (filter p l)
  15 ;; Why not:
  16 ;;   count1 p = length . filter p
  17
  18
  19 (require 'compile)
  20
  21 (defgroup hs-lint nil
  22   "Run HLint as inferior of Emacs, parse error messages."
  23   :group 'tools
  24   :group 'haskell)
  25
  26 (defcustom hs-lint-command "hlint"
  27   "The default hs-lint command for \\[hlint]."
  28   :type 'string
  29   :group 'hs-lint)
  30
  31 (defcustom hs-lint-save-files t
  32   "Save modified files when run HLint or no (ask user)"
  33   :type 'boolean
  34   :group 'hs-lint)
  35
  36 (defcustom hs-lint-replace-with-suggestions nil
  37   "Replace user's code with suggested replacements"
  38   :type 'boolean
  39   :group 'hs-lint)
  40
  41 (defcustom hs-lint-replace-without-ask nil
  42   "Replace user's code with suggested replacements automatically"
  43   :type 'boolean
  44   :group 'hs-lint)
  45
  46 (defun hs-lint-process-setup ()
  47   "Setup compilation variables and buffer for `hlint'."
  48   (run-hooks 'hs-lint-setup-hook))
  49
  50 ;; regex for replace suggestions
  51 ;;
  52 ;; ^\(.*?\):\([0-9]+\):\([0-9]+\): .*
  53 ;; Found:
  54 ;; \s +\(.*\)
  55 ;; Why not:
  56 ;; \s +\(.*\)
  57
  58 (defvar hs-lint-regex
  59   "^\\(.*?\\):\\([0-9]+\\):\\([0-9]+\\): .*[\n\C-m]Found:[\n\C-m]\\s +\\(.*\\)[\n\C-m]Why not:[\n\C-m]\\s +\\(.*\\)[\n\C-m]"
  60   "Regex for HLint messages")
  61
  62 (defun make-short-string (str maxlen)
  63   (if (< (length str) maxlen)
  64       str
  65     (concat (substring str 0 (- maxlen 3)) "...")))
  66
  67 (defun hs-lint-replace-suggestions ()
  68   "Perform actual replacement of suggestions"
  69   (goto-char (point-min))
  70   (while (re-search-forward hs-lint-regex nil t)
  71     (let* ((fname (match-string 1))
  72           (fline (string-to-number (match-string 2)))
  73           (old-code (match-string 4))
  74           (new-code (match-string 5))
  75           (msg (concat "Replace '" (make-short-string old-code 30)
  76                        "' with '" (make-short-string new-code 30) "'"))
  77           (bline 0)
  78           (eline 0)
  79           (spos 0)
  80           (new-old-code ""))
  81       (save-excursion
  82         (switch-to-buffer (get-file-buffer fname))
  83         (goto-line fline)
  84         (beginning-of-line)
  85         (setf bline (point))
  86         (when (or hs-lint-replace-without-ask
  87                   (yes-or-no-p msg))
  88           (end-of-line)
  89           (setf eline (point))
  90           (beginning-of-line)
  91           (setf old-code (regexp-quote old-code))
  92           (while (string-match "\\\\ " old-code spos)
  93             (setf new-old-code (concat new-old-code
  94                                  (substring old-code spos (match-beginning 0))
  95                                  "\\ *"))
  96             (setf spos (match-end 0)))
  97           (setf new-old-code (concat new-old-code (substring old-code spos)))
  98           (remove-text-properties bline eline '(composition nil))
  99           (when (re-search-forward new-old-code eline t)
 100             (replace-match new-code nil t)))))))
 101
 102 (defun hs-lint-finish-hook (buf msg)
 103   "Function, that is executed at the end of HLint execution"
 104   (if hs-lint-replace-with-suggestions
 105       (hs-lint-replace-suggestions)
 106       (next-error 1 t)))
 107
 108 (define-compilation-mode hs-lint-mode "HLint"
 109   "Mode for check Haskell source code."
 110   (set (make-local-variable 'compilation-process-setup-function)
 111        'hs-lint-process-setup)
 112   (set (make-local-variable 'compilation-disable-input) t)
 113   (set (make-local-variable 'compilation-scroll-output) nil)
 114   (set (make-local-variable 'compilation-finish-functions)
 115        (list 'hs-lint-finish-hook))
 116   )
 117
 118 (defun hs-lint ()
 119   "Run HLint for current buffer with haskell source"
 120   (interactive)
 121   (save-some-buffers hs-lint-save-files)
 122   (compilation-start (concat hs-lint-command " \"" buffer-file-name "\"")
 123                      'hs-lint-mode))
 124
 125 (provide 'hs-lint)
 126 ;;; hs-lint.el ends here