Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

528 line
21 KiB

4 年之前
  1. ;;; haskell.el --- Top-level Haskell package -*- lexical-binding: t -*-
  2. ;; Copyright © 2014 Chris Done. All rights reserved.
  3. ;; 2016 Arthur Fayzrakhmanov
  4. ;; This file is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation; either version 3, or (at your option)
  7. ;; any later version.
  8. ;; This file is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Commentary:
  15. ;;; Code:
  16. (require 'cl-lib)
  17. (require 'haskell-mode)
  18. (require 'haskell-hoogle)
  19. (require 'haskell-process)
  20. (require 'haskell-debug)
  21. (require 'haskell-interactive-mode)
  22. (require 'haskell-repl)
  23. (require 'haskell-load)
  24. (require 'haskell-commands)
  25. (require 'haskell-modules)
  26. (require 'haskell-string)
  27. (require 'haskell-completions)
  28. (require 'haskell-utils)
  29. (require 'haskell-customize)
  30. (defvar interactive-haskell-mode-map
  31. (let ((map (make-sparse-keymap)))
  32. (define-key map (kbd "C-c C-l") 'haskell-process-load-file)
  33. (define-key map (kbd "C-c C-r") 'haskell-process-reload)
  34. (define-key map (kbd "C-c C-t") 'haskell-process-do-type)
  35. (define-key map (kbd "C-c C-i") 'haskell-process-do-info)
  36. (define-key map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag)
  37. (define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear)
  38. (define-key map (kbd "C-c C-c") 'haskell-process-cabal-build)
  39. (define-key map (kbd "C-c C-v") 'haskell-cabal-visit-file)
  40. (define-key map (kbd "C-c C-x") 'haskell-process-cabal)
  41. (define-key map (kbd "C-c C-b") 'haskell-interactive-switch)
  42. (define-key map (kbd "C-c C-z") 'haskell-interactive-switch)
  43. map)
  44. "Keymap for using `interactive-haskell-mode'.")
  45. ;;;###autoload
  46. (define-minor-mode interactive-haskell-mode
  47. "Minor mode for enabling haskell-process interaction."
  48. :lighter " Interactive"
  49. :keymap interactive-haskell-mode-map
  50. (add-hook 'completion-at-point-functions
  51. #'haskell-completions-sync-repl-completion-at-point
  52. nil
  53. t))
  54. (make-obsolete 'haskell-process-completions-at-point
  55. 'haskell-completions-sync-repl-completion-at-point
  56. "June 19, 2015")
  57. (defun haskell-process-completions-at-point ()
  58. "A `completion-at-point' function using the current haskell process."
  59. (when (haskell-session-maybe)
  60. (let ((process (haskell-process))
  61. symbol-bounds)
  62. (cond
  63. ;; ghci can complete module names, but it needs the "import "
  64. ;; string at the beginning
  65. ((looking-back (rx line-start
  66. "import" (1+ space)
  67. (? "qualified" (1+ space))
  68. (group (? (char upper) ; modid
  69. (* (char alnum ?' ?.)))))
  70. (line-beginning-position))
  71. (let ((text (match-string-no-properties 0))
  72. (start (match-beginning 1))
  73. (end (match-end 1)))
  74. (list start end
  75. (haskell-process-get-repl-completions process text))))
  76. ;; Complete OPTIONS, a completion list comes from variable
  77. ;; `haskell-ghc-supported-options'
  78. ((and (nth 4 (syntax-ppss))
  79. (save-excursion
  80. (let ((p (point)))
  81. (and (search-backward "{-#" nil t)
  82. (search-forward-regexp "\\_<OPTIONS\\(?:_GHC\\)?\\_>" p t))))
  83. (looking-back
  84. (rx symbol-start "-" (* (char alnum ?-)))
  85. (line-beginning-position)))
  86. (list (match-beginning 0) (match-end 0) haskell-ghc-supported-options))
  87. ;; Complete LANGUAGE, a list of completions comes from variable
  88. ;; `haskell-ghc-supported-extensions'
  89. ((and (nth 4 (syntax-ppss))
  90. (save-excursion
  91. (let ((p (point)))
  92. (and (search-backward "{-#" nil t)
  93. (search-forward-regexp "\\_<LANGUAGE\\_>" p t))))
  94. (setq symbol-bounds (bounds-of-thing-at-point 'symbol)))
  95. (list (car symbol-bounds) (cdr symbol-bounds)
  96. haskell-ghc-supported-extensions))
  97. ((setq symbol-bounds (haskell-ident-pos-at-point))
  98. (cl-destructuring-bind (start . end) symbol-bounds
  99. (list start end
  100. (haskell-process-get-repl-completions
  101. process (buffer-substring-no-properties start end)))))))))
  102. ;;;###autoload
  103. (defun haskell-interactive-mode-return ()
  104. "Handle the return key."
  105. (interactive)
  106. (cond
  107. ;; At a compile message, jump to the location of the error in the
  108. ;; source.
  109. ((haskell-interactive-at-compile-message)
  110. (next-error-internal))
  111. ;; At the input prompt, handle the expression in the usual way.
  112. ((haskell-interactive-at-prompt)
  113. (haskell-interactive-handle-expr))
  114. ;; At any other location in the buffer, copy the line to the
  115. ;; current prompt.
  116. (t
  117. (haskell-interactive-copy-to-prompt))))
  118. ;;;###autoload
  119. (defun haskell-session-kill (&optional leave-interactive-buffer)
  120. "Kill the session process and buffer, delete the session.
  121. 0. Prompt to kill all associated buffers.
  122. 1. Kill the process.
  123. 2. Kill the interactive buffer unless LEAVE-INTERACTIVE-BUFFER is not given.
  124. 3. Walk through all the related buffers and set their haskell-session to nil.
  125. 4. Remove the session from the sessions list."
  126. (interactive)
  127. (haskell-mode-toggle-interactive-prompt-state)
  128. (unwind-protect
  129. (let* ((session (haskell-session))
  130. (name (haskell-session-name session))
  131. (also-kill-buffers
  132. (and haskell-ask-also-kill-buffers
  133. (y-or-n-p
  134. (format "Killing `%s'. Also kill all associated buffers?"
  135. name)))))
  136. (haskell-kill-session-process session)
  137. (unless leave-interactive-buffer
  138. (kill-buffer (haskell-session-interactive-buffer session)))
  139. (cl-loop for buffer in (buffer-list)
  140. do (with-current-buffer buffer
  141. (when (and (boundp 'haskell-session)
  142. (string= (haskell-session-name haskell-session)
  143. name))
  144. (setq haskell-session nil)
  145. (when also-kill-buffers
  146. (kill-buffer)))))
  147. (setq haskell-sessions
  148. (cl-remove-if (lambda (session)
  149. (string= (haskell-session-name session)
  150. name))
  151. haskell-sessions)))
  152. (haskell-mode-toggle-interactive-prompt-state t)))
  153. ;;;###autoload
  154. (defun haskell-interactive-kill ()
  155. "Kill the buffer and (maybe) the session."
  156. (interactive)
  157. (when (eq major-mode 'haskell-interactive-mode)
  158. (haskell-mode-toggle-interactive-prompt-state)
  159. (unwind-protect
  160. (when (and (boundp 'haskell-session)
  161. haskell-session
  162. (y-or-n-p "Kill the whole session?"))
  163. (haskell-session-kill t)))
  164. (haskell-mode-toggle-interactive-prompt-state t)))
  165. (defun haskell-session-make (name)
  166. "Make a Haskell session."
  167. (when (haskell-session-lookup name)
  168. (error "Session of name %s already exists!" name))
  169. (let ((session (setq haskell-session
  170. (list (cons 'name name)))))
  171. (add-to-list 'haskell-sessions session)
  172. (haskell-process-start session)
  173. session))
  174. (defun haskell-session-new-assume-from-cabal ()
  175. "Prompt to create a new project based on a guess from the nearest Cabal file.
  176. If `haskell-process-load-or-reload-prompt' is nil, accept `default'."
  177. (let ((name (haskell-session-default-name)))
  178. (unless (haskell-session-lookup name)
  179. (haskell-mode-toggle-interactive-prompt-state)
  180. (unwind-protect
  181. (if (or (not haskell-process-load-or-reload-prompt)
  182. (y-or-n-p (format "Start a new project named “%s”? " name)))
  183. (haskell-session-make name))
  184. (haskell-mode-toggle-interactive-prompt-state t)))))
  185. ;;;###autoload
  186. (defun haskell-session ()
  187. "Get the Haskell session, prompt if there isn't one or fail."
  188. (or (haskell-session-maybe)
  189. (haskell-session-assign
  190. (or (haskell-session-from-buffer)
  191. (haskell-session-new-assume-from-cabal)
  192. (haskell-session-choose)
  193. (haskell-session-new)))))
  194. ;;;###autoload
  195. (defun haskell-interactive-switch ()
  196. "Switch to the interactive mode for this session."
  197. (interactive)
  198. (let ((initial-buffer (current-buffer))
  199. (buffer (haskell-session-interactive-buffer (haskell-session))))
  200. (with-current-buffer buffer
  201. (setq haskell-interactive-previous-buffer initial-buffer))
  202. (unless (eq buffer (window-buffer))
  203. (switch-to-buffer-other-window buffer))))
  204. (defun haskell-session-new ()
  205. "Make a new session."
  206. (let ((name (read-from-minibuffer "Project name: " (haskell-session-default-name))))
  207. (when (not (string= name ""))
  208. (let ((session (haskell-session-lookup name)))
  209. (haskell-mode-toggle-interactive-prompt-state)
  210. (unwind-protect
  211. (if session
  212. (when
  213. (y-or-n-p
  214. (format "Session %s already exists. Use it?" name))
  215. session)
  216. (haskell-session-make name)))
  217. (haskell-mode-toggle-interactive-prompt-state t)))))
  218. ;;;###autoload
  219. (defun haskell-session-change ()
  220. "Change the session for the current buffer."
  221. (interactive)
  222. (haskell-session-assign (or (haskell-session-new-assume-from-cabal)
  223. (haskell-session-choose)
  224. (haskell-session-new))))
  225. (defun haskell-process-prompt-restart (process)
  226. "Prompt to restart the died PROCESS."
  227. (let ((process-name (haskell-process-name process))
  228. (cursor-in-echo-area t))
  229. (if haskell-process-suggest-restart
  230. (progn
  231. (haskell-mode-toggle-interactive-prompt-state)
  232. (unwind-protect
  233. (cond
  234. ((string-match "You need to re-run the 'configure' command."
  235. (haskell-process-response process))
  236. (cl-case (read-char-choice
  237. (concat
  238. "The Haskell process ended. Cabal wants you to run "
  239. (propertize "cabal configure"
  240. 'face
  241. 'font-lock-keyword-face)
  242. " because there is a version mismatch. Re-configure (y, n, l: view log)?"
  243. "\n\n"
  244. "Cabal said:\n\n"
  245. (propertize (haskell-process-response process)
  246. 'face
  247. 'font-lock-comment-face))
  248. '(?l ?n ?y))
  249. (?y (let ((default-directory
  250. (haskell-session-cabal-dir
  251. (haskell-process-session process))))
  252. (message "%s"
  253. (shell-command-to-string "cabal configure"))))
  254. (?l (let* ((response (haskell-process-response process))
  255. (buffer (get-buffer "*haskell-process-log*")))
  256. (if buffer
  257. (switch-to-buffer buffer)
  258. (progn (switch-to-buffer
  259. (get-buffer-create "*haskell-process-log*"))
  260. (insert response)))))
  261. (?n)))
  262. (t
  263. (cl-case (read-char-choice
  264. (propertize
  265. (format "The Haskell process `%s' has died. Restart? (y, n, l: show process log) "
  266. process-name)
  267. 'face
  268. 'minibuffer-prompt)
  269. '(?l ?n ?y))
  270. (?y (haskell-process-start (haskell-process-session process)))
  271. (?l (let* ((response (haskell-process-response process))
  272. (buffer (get-buffer "*haskell-process-log*")))
  273. (if buffer
  274. (switch-to-buffer buffer)
  275. (progn (switch-to-buffer
  276. (get-buffer-create "*haskell-process-log*"))
  277. (insert response)))))
  278. (?n))))
  279. ;; unwind
  280. (haskell-mode-toggle-interactive-prompt-state t)))
  281. (message "The Haskell process `%s' is dearly departed." process-name))))
  282. (defun haskell-process ()
  283. "Get the current process from the current session."
  284. (haskell-session-process (haskell-session)))
  285. ;;;###autoload
  286. (defun haskell-kill-session-process (&optional session)
  287. "Kill the process."
  288. (interactive)
  289. (let* ((session (or session (haskell-session)))
  290. (existing-process (get-process (haskell-session-name session))))
  291. (when (processp existing-process)
  292. (haskell-interactive-mode-echo session "Killing process ...")
  293. (haskell-process-set (haskell-session-process session) 'is-restarting t)
  294. (delete-process existing-process))))
  295. ;;;###autoload
  296. (defun haskell-interactive-mode-visit-error ()
  297. "Visit the buffer of the current (or last) error message."
  298. (interactive)
  299. (with-current-buffer (haskell-session-interactive-buffer (haskell-session))
  300. (if (progn (goto-char (line-beginning-position))
  301. (looking-at haskell-interactive-mode-error-regexp))
  302. (progn (forward-line -1)
  303. (haskell-interactive-jump-to-error-line))
  304. (progn (goto-char (point-max))
  305. (haskell-interactive-mode-error-backward)
  306. (haskell-interactive-jump-to-error-line)))))
  307. (defvar xref-prompt-for-identifier nil)
  308. ;;;###autoload
  309. (defun haskell-mode-jump-to-tag (&optional next-p)
  310. "Jump to the tag of the given identifier.
  311. Give optional NEXT-P parameter to override value of
  312. `xref-prompt-for-identifier' during definition search."
  313. (interactive "P")
  314. (let ((ident (haskell-string-drop-qualifier (haskell-ident-at-point)))
  315. (tags-file-dir (haskell-cabal--find-tags-dir))
  316. (tags-revert-without-query t))
  317. (when (and ident
  318. (not (string= "" (haskell-string-trim ident)))
  319. tags-file-dir)
  320. (let ((tags-file-name (concat tags-file-dir "TAGS")))
  321. (cond ((file-exists-p tags-file-name)
  322. (let ((xref-prompt-for-identifier next-p))
  323. (xref-find-definitions ident)))
  324. (t (haskell-mode-generate-tags ident)))))))
  325. ;;;###autoload
  326. (defun haskell-mode-after-save-handler ()
  327. "Function that will be called after buffer's saving."
  328. (when haskell-tags-on-save
  329. (ignore-errors (haskell-mode-generate-tags))))
  330. ;;;###autoload
  331. (defun haskell-mode-tag-find (&optional _next-p)
  332. "The tag find function, specific for the particular session."
  333. (interactive "P")
  334. (cond
  335. ((elt (syntax-ppss) 3) ;; Inside a string
  336. (haskell-mode-jump-to-filename-in-string))
  337. (t (call-interactively 'haskell-mode-jump-to-tag))))
  338. (defun haskell-mode-jump-to-filename-in-string ()
  339. "Jump to the filename in the current string."
  340. (let* ((string (save-excursion
  341. (buffer-substring-no-properties
  342. (1+ (search-backward-regexp "\"" (line-beginning-position) nil 1))
  343. (1- (progn (forward-char 1)
  344. (search-forward-regexp "\"" (line-end-position) nil 1))))))
  345. (fp (expand-file-name string
  346. (haskell-session-cabal-dir (haskell-session)))))
  347. (find-file
  348. (read-file-name
  349. ""
  350. fp
  351. fp))))
  352. ;;;###autoload
  353. (defun haskell-interactive-bring ()
  354. "Bring up the interactive mode for this session."
  355. (interactive)
  356. (let* ((session (haskell-session))
  357. (buffer (haskell-session-interactive-buffer session)))
  358. (pop-to-buffer buffer)))
  359. ;;;###autoload
  360. (defun haskell-process-load-file ()
  361. "Load the current buffer file."
  362. (interactive)
  363. (save-buffer)
  364. (haskell-interactive-mode-reset-error (haskell-session))
  365. (haskell-process-file-loadish (format "load \"%s\"" (replace-regexp-in-string
  366. "\""
  367. "\\\\\""
  368. (buffer-file-name)))
  369. nil
  370. (current-buffer)))
  371. ;;;###autoload
  372. (defun haskell-process-reload ()
  373. "Re-load the current buffer file."
  374. (interactive)
  375. (save-buffer)
  376. (haskell-interactive-mode-reset-error (haskell-session))
  377. (haskell-process-file-loadish "reload" t (current-buffer)))
  378. ;;;###autoload
  379. (defun haskell-process-reload-file () (haskell-process-reload))
  380. (make-obsolete 'haskell-process-reload-file 'haskell-process-reload
  381. "2015-11-14")
  382. ;;;###autoload
  383. (defun haskell-process-load-or-reload (&optional toggle)
  384. "Load or reload. Universal argument toggles which."
  385. (interactive "P")
  386. (if toggle
  387. (progn (setq haskell-reload-p (not haskell-reload-p))
  388. (message "%s (No action taken this time)"
  389. (if haskell-reload-p
  390. "Now running :reload."
  391. "Now running :load <buffer-filename>.")))
  392. (if haskell-reload-p (haskell-process-reload) (haskell-process-load-file))))
  393. (make-obsolete 'haskell-process-load-or-reload 'haskell-process-load-file
  394. "2015-11-14")
  395. ;;;###autoload
  396. (defun haskell-process-cabal-build ()
  397. "Build the Cabal project."
  398. (interactive)
  399. (haskell-process-do-cabal "build")
  400. (haskell-process-add-cabal-autogen))
  401. ;;;###autoload
  402. (defun haskell-process-cabal (p)
  403. "Prompts for a Cabal command to run."
  404. (interactive "P")
  405. (if p
  406. (haskell-process-do-cabal
  407. (read-from-minibuffer "Cabal command (e.g. install): "))
  408. (haskell-process-do-cabal
  409. (funcall haskell-completing-read-function "Cabal command: "
  410. (append haskell-cabal-commands
  411. (list "build --ghc-options=-fforce-recomp"))))))
  412. (defun haskell-process-file-loadish (command reload-p module-buffer)
  413. "Run a loading-ish COMMAND that wants to pick up type errors\
  414. and things like that. RELOAD-P indicates whether the notification
  415. should say 'reloaded' or 'loaded'. MODULE-BUFFER may be used
  416. for various things, but is optional."
  417. (let ((session (haskell-session)))
  418. (haskell-session-current-dir session)
  419. (when haskell-process-check-cabal-config-on-load
  420. (haskell-process-look-config-changes session))
  421. (let ((process (haskell-process)))
  422. (haskell-process-queue-command
  423. process
  424. (make-haskell-command
  425. :state (list session process command reload-p module-buffer)
  426. :go (lambda (state)
  427. (haskell-process-send-string
  428. (cadr state) (format ":%s" (cl-caddr state))))
  429. :live (lambda (state buffer)
  430. (haskell-process-live-build
  431. (cadr state) buffer nil))
  432. :complete (lambda (state response)
  433. (haskell-process-load-complete
  434. (car state)
  435. (cadr state)
  436. response
  437. (cl-cadddr state)
  438. (cl-cadddr (cdr state)))))))))
  439. ;;;###autoload
  440. (defun haskell-process-minimal-imports ()
  441. "Dump minimal imports."
  442. (interactive)
  443. (unless (> (save-excursion
  444. (goto-char (point-min))
  445. (haskell-navigate-imports-go)
  446. (point))
  447. (point))
  448. (goto-char (point-min))
  449. (haskell-navigate-imports-go))
  450. (haskell-process-queue-sync-request (haskell-process)
  451. ":set -ddump-minimal-imports")
  452. (haskell-process-load-file)
  453. (insert-file-contents-literally
  454. (concat (haskell-session-current-dir (haskell-session))
  455. "/"
  456. (haskell-guess-module-name-from-file-name (buffer-file-name))
  457. ".imports")))
  458. (defun haskell-interactive-jump-to-error-line ()
  459. "Jump to the error line."
  460. (let ((orig-line (buffer-substring-no-properties (line-beginning-position)
  461. (line-end-position))))
  462. (and (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)\\(-[0-9]+\\)?:" orig-line)
  463. (let* ((file (match-string 1 orig-line))
  464. (line (match-string 2 orig-line))
  465. (col (match-string 3 orig-line))
  466. (session (haskell-interactive-session))
  467. (cabal-path (haskell-session-cabal-dir session))
  468. (src-path (haskell-session-current-dir session))
  469. (cabal-relative-file (expand-file-name file cabal-path))
  470. (src-relative-file (expand-file-name file src-path)))
  471. (let ((file (cond ((file-exists-p cabal-relative-file)
  472. cabal-relative-file)
  473. ((file-exists-p src-relative-file)
  474. src-relative-file))))
  475. (when file
  476. (other-window 1)
  477. (find-file file)
  478. (haskell-interactive-bring)
  479. (goto-char (point-min))
  480. (forward-line (1- (string-to-number line)))
  481. (goto-char (+ (point) (string-to-number col) -1))
  482. (haskell-mode-message-line orig-line)
  483. t))))))
  484. (provide 'haskell)
  485. ;;; haskell.el ends here