Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 126 lines (108 sloc) 3.98 kb
949b5553 »
2011-03-17 Added hs-lint, tweaked haskell-mode load.
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
Something went wrong with that request. Please try again.