-
Notifications
You must be signed in to change notification settings - Fork 26
/
flycheck-haskell.el
413 lines (337 loc) · 15.7 KB
/
flycheck-haskell.el
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
;;; flycheck-haskell.el --- Flycheck: Automatic Haskell configuration -*- lexical-binding: t; -*-
;; Copyright (C) 2016-2018 Sergey Vinokurov <[email protected]>
;; Copyright (C) 2014-2016 Sebastian Wiesner <[email protected]>
;; Copyright (C) 2016-2018 Danny Navarro <[email protected]>
;; Copyright (C) 2015 Mark Karpov <[email protected]>
;; Copyright (C) 2015 Michael Alan Dorman <[email protected]>
;; Copyright (C) 2015 Alex Rozenshteyn <[email protected]>
;; Copyright (C) 2014 Gracjan Polak <[email protected]>
;; Author: Sebastian Wiesner <[email protected]>
;; URL: https://github.com/flycheck/flycheck-haskell
;; Keywords: tools, convenience
;; Version: 0.9-cvs
;; Package-Requires: ((emacs "24.3") (flycheck "0.25") (haskell-mode "13.7") (dash "2.4.0") (seq "1.11") (let-alist "1.0.1"))
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Automatically configure Flycheck for Haskell.
;;;; Cabal support
;; Try to find a Cabal file for the current Haskell buffer, and configure syntax
;; checking according to the Cabal project settings.
;;;; Cabal sandboxes
;; Try to find a Cabal sandbox configuration for this project, and configure the
;; Haskell syntax checkers in Flycheck to use the package database from the
;; Sandbox.
;;;; Stack support
;; Try to find a stack.yaml file for current project and configure stack projct
;; according to the Stack project settings.
;;;; Setup
;; (add-hook 'flycheck-mode-hook #'flycheck-haskell-setup)
;;; Code:
(eval-when-compile
(require 'rx)
(require 'let-alist))
(require 'seq)
(require 'haskell-cabal)
(require 'flycheck)
(require 'dash)
;;; Customization
(defgroup flycheck-haskell nil
"Haskell support for Flycheck."
:prefix "flycheck-haskell-"
:group 'flycheck
:link '(url-link :tag "Github" "https://github.com/flycheck/flycheck-haskell"))
(defcustom flycheck-haskell-runghc-command
(let ((stack-exe (funcall flycheck-executable-find "stack"))
(runghc-exe (funcall flycheck-executable-find "runghc")))
(cond
(stack-exe
`(,stack-exe "--verbosity" "silent" "runghc" "--no-ghc-package-path" "--" "-i"
"-packageCabal"
"-packageCabal-syntax"
"-packagebase"
"-packagebytestring"
"-packagecontainers"
"-packageprocess"
"-packagedirectory"
"-packagefilepath"))
(runghc-exe
`(,runghc-exe "--" "-i"
"-packageCabal"
"-packageCabal-syntax"
"-packagebase"
"-packagebytestring"
"-packagecontainers"
"-packageprocess"
"-packagedirectory"
"-packagefilepath"))
(t
;; A reasonable default.
'("runghc" "-i"))))
"Command for `runghc'.
This library uses `runghc' to run various Haskell helper scripts
to extract information from Cabal files. This option provides
the command to invoke `runghc'. The default is to use `stack'
and otherwise fall back to standard `runghc'."
:type '(repeat (string :tag "Command"))
:risky t
:group 'flycheck-haskell)
(defcustom flycheck-haskell-hpack-executable (funcall flycheck-executable-find "hpack")
"Path to the `hpack' executable.
This library uses `hpack' to get package configuration if `package.yaml' file
is present. This option provides the path to the `hpack' executable. The nil
value will make this library ignore `package.yaml' file, even if it's present."
:type 'string
:risky t
:group 'flycheck-haskell)
(defcustom flycheck-haskell-hpack-preference 'prefer-hpack
"How to handle projects with both `.cabal' and `package.yaml' files present.
This option controls which configuration file this library will pick for
a project that has both `.cabal' and `package.yaml' files present.
The default, 'prefer-hpack, will make it pick `package.yaml' file as the source
of configuration parameters. Another possible value, 'prefer-cabal will
make it pick `.cabal' file in such a case."
:group 'flycheck-haskell
:type '(set (const :tag "Prefer hpack's \"package.yaml\" file" prefer-hpack)
(const :tag "Prefer cabal's \".cabal\" file" prefer-cabal))
:safe #'symbolp)
;;; Cabal support
(defconst flycheck-haskell-directory
(file-name-directory (if load-in-progress
load-file-name
(buffer-file-name)))
"The package directory of flycheck-haskell.")
(defconst flycheck-haskell-helper
(expand-file-name "get-cabal-configuration.hs" flycheck-haskell-directory)
"The helper to dump the Cabal configuration.")
(defun flycheck-haskell-runghc-command (args)
"Create a runghc command with ARGS.
Take the base command from `flycheck-haskell-runghc-command'."
(append flycheck-haskell-runghc-command args nil))
(defun flycheck-haskell--read-configuration-with-helper (command)
;; Copy enivronment variables into the new process, since
;; with-temp-buffer will re-use the variables' defaults, even if
;; they have been changed in this buffer by e.g. envrc-mode.
;; See https://github.com/purcell/envrc/issues/12.
(let ((env process-environment)
(path exec-path))
(with-temp-buffer
;; Copy the entire environment just in case there's something we need.
(setq-local process-environment env)
;; Set path so we can find the command.
(setq-local exec-path path)
;; Hack around call-process' limitation handling standard error
(let ((error-file (make-temp-file "flycheck-haskell-errors")))
(pcase (apply 'call-process (car command) nil (list t error-file) nil (cdr command))
(0 (delete-file error-file)
(goto-char (point-min))
(read (current-buffer)))
(retcode (insert-file-contents error-file)
(delete-file error-file)
(message "Reading Haskell configuration failed with exit code %s and output:\n%s"
retcode (buffer-string))
nil))))))
(defun flycheck-haskell-read-cabal-configuration (cabal-file)
"Read the Cabal configuration from CABAL-FILE."
(let ((args (list flycheck-haskell-helper "--cabal-file" (expand-file-name cabal-file))))
(flycheck-haskell--read-configuration-with-helper
(flycheck-haskell-runghc-command args))))
(defun flycheck-haskell-read-hpack-configuration (hpack-file)
"Read the hpack configuration from HPACK-FILE."
(cl-assert flycheck-haskell-hpack-executable)
(let ((args (list flycheck-haskell-helper
"--hpack-exe" flycheck-haskell-hpack-executable
"--hpack-file" (expand-file-name hpack-file))))
(flycheck-haskell--read-configuration-with-helper
(flycheck-haskell-runghc-command args))))
(defun flycheck-haskell--delete-dups (xs)
"Remove duplicates from a list XS using `equal'. Leaves initial
list unchanged."
(copy-sequence (delete-dups xs)))
;;; Cabal configuration caching
(defconst flycheck-haskell-config-cache (make-hash-table :test 'equal)
"Cache of Cabal configuration.
A hash table, mapping the name of a cabal file to a
cons-cell `(MODTIME . CONFIG)', where MODTIME is the modification
time of the cabal file, and CONFIG the extracted configuration.")
(defun flycheck-haskell-clear-config-cache ()
"Clear the cache of configurations."
(interactive)
(clrhash flycheck-haskell-config-cache))
(defun flycheck-haskell-get-cached-configuration (config-file)
"Get the cached configuration for CABAL-FILE.
Return the cached configuration, or nil, if there is no cache
entry, or if the cache entry is outdated."
(pcase-let* ((cache-entry (gethash config-file flycheck-haskell-config-cache))
(`(,modtime . ,config) cache-entry))
(when (and modtime (file-exists-p config-file))
(let ((current-modtime (nth 5 (file-attributes config-file))))
(if (time-less-p modtime current-modtime)
;; The entry is outdated, drop it. `remhash' always
;; returns nil, so we are safe to use it here.
(remhash config-file flycheck-haskell-config-cache)
;; The configuration is up to date, use it
config)))))
(defun flycheck-haskell-read-and-cache-configuration (config-file)
"Read and cache configuration from CABAL-FILE.
Return the configuration."
(let ((modtime (nth 5 (file-attributes config-file)))
(config (if (equal "yaml" (file-name-extension config-file))
(flycheck-haskell-read-hpack-configuration config-file)
(flycheck-haskell-read-cabal-configuration config-file))))
(puthash config-file (cons modtime config) flycheck-haskell-config-cache)
config))
(defun flycheck-haskell-get-configuration (config-file)
"Get the Cabal configuration from CABAL-FILE.
Get the configuration either from our cache, or by reading the
CABAL-FILE.
Return the configuration."
(or (flycheck-haskell-get-cached-configuration config-file)
(flycheck-haskell-read-and-cache-configuration config-file)))
;;; Cabal sandbox support
(defconst flycheck-haskell-cabal-config "cabal.config"
"The file name of a Cabal configuration.")
(defconst flycheck-haskell-cabal-config-keys '(with-compiler)
"Keys to parse from a Cabal configuration file.")
(defconst flycheck-haskell-sandbox-config "cabal.sandbox.config"
"The file name of a Cabal sandbox configuration.")
(defconst flycheck-haskell-sandbox-config-keys '(package-db)
"Keys to parse from a Cabal sandbox configuration.")
(defmacro flycheck-haskell-with-config-file-buffer (file-name &rest body)
"Eval BODY in a buffer with the contents of FILE-NAME."
(declare (indent 1))
`(with-temp-buffer
(insert-file-contents ,file-name)
(goto-char (point-min))
,@body))
(defun flycheck-haskell-get-config-value (key)
"Get the value of a configuration KEY from this buffer.
KEY is a symbol denoting the key whose value to get. Return
a `(KEY . VALUE)' cons cell."
(save-excursion
(goto-char (point-min))
(let ((setting (haskell-cabal--get-field (symbol-name key))))
(when setting
(cons key (substring-no-properties setting))))))
(defun flycheck-haskell-parse-config-file (keys config-file)
"Parse KEYS from CONFIG-FILE.
KEYS is a list of symbols. Return an alist with all parsed
KEYS."
(flycheck-haskell-with-config-file-buffer config-file
(mapcar #'flycheck-haskell-get-config-value keys)))
(defun flycheck-haskell-find-config (config-file)
"Find a CONFIG-FILE for the current buffer.
Return the absolute path of CONFIG-FILE as string, or nil if
CONFIG-FILE was not found."
(let ((root-dir (locate-dominating-file (buffer-file-name) config-file)))
(when root-dir
(expand-file-name config-file root-dir))))
(defun flycheck-haskell-get-cabal-config ()
"Get Cabal configuration for the current buffer.
Return an alist with the Cabal configuration for the current
buffer."
(let ((file-name (flycheck-haskell-find-config
flycheck-haskell-cabal-config)))
(when file-name
(flycheck-haskell-parse-config-file flycheck-haskell-cabal-config-keys
file-name))))
(defun flycheck-haskell-get-sandbox-config ()
"Get sandbox configuration for the current buffer.
Return an alist with the sandbox configuration for the current
buffer."
(let ((file-name (flycheck-haskell-find-config
flycheck-haskell-sandbox-config)))
(when file-name
(flycheck-haskell-parse-config-file flycheck-haskell-sandbox-config-keys
file-name))))
;;; Buffer setup
(defun flycheck-haskell-process-configuration (config)
"Process the a Cabal CONFIG."
(let-alist config
(setq-local flycheck-ghc-search-path
(flycheck-haskell--delete-dups
(append .build-directories .source-directories
flycheck-ghc-search-path)))
(setq-local flycheck-ghc-language-extensions
(flycheck-haskell--delete-dups
(append .extensions .languages
flycheck-ghc-language-extensions)))
(setq-local flycheck-ghc-args
(flycheck-haskell--delete-dups
(append .other-options
(seq-map (apply-partially #'concat "-I")
.autogen-directories)
(when (car .should-include-version-header)
'("-optP-include" "-optPcabal_macros.h"))
(when (not (car .package-env-exists))
(cons "-hide-all-packages"
(seq-map (apply-partially #'concat "-package=")
.dependencies)))
(seq-map (apply-partially #'concat "-I")
.include-directories)
flycheck-ghc-args)))
(setq-local flycheck-hlint-args
(flycheck-haskell--delete-dups
(append (seq-map (apply-partially #'concat "--cpp-include=")
.autogen-directories)
'("--cpp-file=cabal_macros.h"))))))
(defun flycheck-haskell-configure ()
"Set paths and package database for the current project."
(interactive)
(when (and (buffer-file-name) (file-directory-p default-directory))
(let ((config-file (flycheck-haskell--find-config-file)))
(when config-file
(let ((config (flycheck-haskell-get-configuration config-file)))
(when config
(flycheck-haskell-process-configuration config)))))
(let-alist (flycheck-haskell-get-cabal-config)
(when .with-compiler
(setq-local flycheck-haskell-ghc-executable .with-compiler)))
(let-alist (flycheck-haskell-get-sandbox-config)
(when .package-db
(setq-local flycheck-ghc-package-databases
(flycheck-haskell--delete-dups
(cons .package-db flycheck-ghc-package-databases)))
(setq-local flycheck-ghc-no-user-package-database t)))))
(defun flycheck-haskell--find-config-file ()
(let* ((cabal-file (haskell-cabal-find-file))
(hpack-dir
(and flycheck-haskell-hpack-executable
(locate-dominating-file default-directory "package.yaml")))
(hpack-file
(when hpack-dir
(concat hpack-dir "/package.yaml"))))
(if cabal-file
(if hpack-file
(cond
((eq 'prefer-hpack flycheck-haskell-hpack-preference)
hpack-file)
(t
cabal-file))
cabal-file)
hpack-file)))
;;;###autoload
(defun flycheck-haskell-setup ()
"Setup Haskell support for Flycheck.
If the current file is part of a Cabal project, configure
Flycheck to take the module paths of the Cabal projects into
account.
Also search for Cabal sandboxes and add them to the module search
path as well."
(flycheck-haskell-configure)
(add-hook 'hack-local-variables-hook #'flycheck-haskell-configure))
(provide 'flycheck-haskell)
;; Local Variables:
;; indent-tabs-mode: nil
;; coding: utf-8
;; End:
;;; flycheck-haskell.el ends here