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