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.

644 lines
27 KiB

4 years ago
  1. ;;; haskell-load.el --- Compiling and loading modules in the GHCi process -*- 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-process)
  19. (require 'haskell-interactive-mode)
  20. (require 'haskell-modules)
  21. (require 'haskell-commands)
  22. (require 'haskell-session)
  23. (require 'haskell-string)
  24. (defun haskell-process-look-config-changes (session)
  25. "Check whether a cabal configuration file has changed.
  26. Restarts the SESSION's process if that is the case."
  27. (let ((current-checksum (haskell-session-get session 'cabal-checksum))
  28. (new-checksum (haskell-cabal-compute-checksum
  29. (haskell-session-get session 'cabal-dir))))
  30. (when (not (string= current-checksum new-checksum))
  31. (haskell-interactive-mode-echo
  32. session
  33. (format "Cabal file changed: %s" new-checksum))
  34. (haskell-session-set-cabal-checksum
  35. session
  36. (haskell-session-get session 'cabal-dir))
  37. (haskell-mode-toggle-interactive-prompt-state)
  38. (unwind-protect
  39. (unless
  40. (and haskell-process-prompt-restart-on-cabal-change
  41. (not
  42. (y-or-n-p "Cabal file changed. Restart GHCi process? ")))
  43. (haskell-process-start (haskell-interactive-session)))
  44. (haskell-mode-toggle-interactive-prompt-state t)))))
  45. (defun haskell-process-live-build (process buffer echo-in-repl)
  46. "Show live updates for loading files."
  47. (cond
  48. ((haskell-process-consume
  49. process
  50. (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
  51. " Compiling \\([^ ]+\\)[ ]+"
  52. "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
  53. (haskell-process-echo-load-message process buffer echo-in-repl nil)
  54. t)
  55. ((haskell-process-consume
  56. process
  57. (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
  58. " Compiling \\[TH\\] \\([^ ]+\\)[ ]+"
  59. "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
  60. (haskell-process-echo-load-message process buffer echo-in-repl t)
  61. t)
  62. ((haskell-process-consume
  63. process
  64. "Loading package \\([^ ]+\\) ... linking ... done.\n")
  65. (haskell-mode-message-line
  66. (format "Loading: %s"
  67. (match-string 1 buffer)))
  68. t)
  69. ((haskell-process-consume
  70. process
  71. "^Preprocessing executables for \\(.+?\\)\\.\\.\\.")
  72. (let ((msg (format "Preprocessing: %s" (match-string 1 buffer))))
  73. (haskell-interactive-mode-echo (haskell-process-session process) msg)
  74. (haskell-mode-message-line msg)))
  75. ((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.")
  76. (let ((msg (format "Linking: %s" (match-string 1 buffer))))
  77. (haskell-interactive-mode-echo (haskell-process-session process) msg)
  78. (haskell-mode-message-line msg)))
  79. ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.")
  80. (let ((msg (format "Building: %s" (match-string 1 buffer))))
  81. (haskell-interactive-mode-echo (haskell-process-session process) msg)
  82. (haskell-mode-message-line msg)))
  83. ((string-match "Collecting type info for [[:digit:]]+ module(s) \\.\\.\\."
  84. (haskell-process-response process)
  85. (haskell-process-response-cursor process))
  86. (haskell-mode-message-line (match-string 0 buffer))
  87. ;; Do not consume "Ok, modules loaded" that goes before
  88. ;; "Collecting type info...", just exit.
  89. nil)))
  90. (defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont)
  91. "Handle the complete loading response. BUFFER is the string of
  92. text being sent over the process pipe. MODULE-BUFFER is the
  93. actual Emacs buffer of the module being loaded."
  94. (when (get-buffer (format "*%s:splices*" (haskell-session-name session)))
  95. (with-current-buffer (haskell-interactive-mode-splices-buffer session)
  96. (erase-buffer)))
  97. (let* ((ok (cond
  98. ((haskell-process-consume
  99. process
  100. "Ok, \\(?:[0-9]+\\) modules? loaded\\.$")
  101. t)
  102. ((haskell-process-consume
  103. process
  104. "Ok, \\(?:[a-z]+\\) modules? loaded\\.$") ;; for ghc 8.4
  105. t)
  106. ((haskell-process-consume
  107. process
  108. "Failed, \\(?:[0-9]+\\) modules? loaded\\.$")
  109. nil)
  110. ((haskell-process-consume
  111. process
  112. "Failed, \\(?:[a-z]+\\) modules? loaded\\.$") ;; ghc 8.6.3 says so
  113. nil)
  114. ((haskell-process-consume
  115. process
  116. "Ok, modules loaded: \\(.+\\)\\.$")
  117. t)
  118. ((haskell-process-consume
  119. process
  120. "Failed, modules loaded: \\(.+\\)\\.$")
  121. nil)
  122. ((haskell-process-consume
  123. process
  124. "Failed, no modules loaded\\.$") ;; for ghc 8.4
  125. nil)
  126. (t
  127. (error (message "Unexpected response from haskell process.")))))
  128. (modules (haskell-process-extract-modules buffer))
  129. (cursor (haskell-process-response-cursor process))
  130. (warning-count 0))
  131. (haskell-process-set-response-cursor process 0)
  132. (haskell-check-remove-overlays module-buffer)
  133. (while
  134. (haskell-process-errors-warnings module-buffer session process buffer)
  135. (setq warning-count (1+ warning-count)))
  136. (haskell-process-set-response-cursor process cursor)
  137. (if (and (not reload)
  138. haskell-process-reload-with-fbytecode)
  139. (haskell-process-reload-with-fbytecode process module-buffer)
  140. (haskell-process-import-modules process (car modules)))
  141. (if ok
  142. (haskell-mode-message-line (if reload "Reloaded OK." "OK."))
  143. (haskell-interactive-mode-compile-error session "Compilation failed."))
  144. (when cont
  145. (condition-case-unless-debug e
  146. (funcall cont ok)
  147. (error (message "%S" e))
  148. (quit nil)))))
  149. (defun haskell-process-suggest-imports (session file modules ident)
  150. "Suggest add missed imports to file.
  151. Asks user to add to SESSION's FILE missed import. MODULES is a
  152. list of modules where missed IDENT was found."
  153. (cl-assert session)
  154. (cl-assert file)
  155. (cl-assert ident)
  156. (haskell-mode-toggle-interactive-prompt-state)
  157. (unwind-protect
  158. (let* ((process (haskell-session-process session))
  159. (suggested-already (haskell-process-suggested-imports process))
  160. (module
  161. (cond
  162. ((> (length modules) 1)
  163. (when (y-or-n-p
  164. (format
  165. "Identifier `%s' not in scope, choose module to import?"
  166. ident))
  167. (haskell-complete-module-read "Module: " modules)))
  168. ((= (length modules) 1)
  169. (let ((module (car modules)))
  170. (unless (member module suggested-already)
  171. (haskell-process-set-suggested-imports
  172. process
  173. (cons module suggested-already))
  174. (when (y-or-n-p
  175. (format "Identifier `%s' not in scope, import `%s'?"
  176. ident
  177. module))
  178. module)))))))
  179. (when module
  180. (haskell-process-find-file session file)
  181. (haskell-add-import module)))
  182. (haskell-mode-toggle-interactive-prompt-state t)))
  183. (defun haskell-process-trigger-suggestions (session msg file line)
  184. "Trigger prompting to add any extension suggestions."
  185. (cond ((let ((case-fold-search nil))
  186. (or
  187. (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg)
  188. (not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg)))
  189. (string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg)
  190. (string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg)
  191. (string-match "Use \\([A-Z][A-Za-z]+\\) to enable" msg)
  192. (string-match
  193. "Use \\([A-Z][A-Za-z]+\\) if you want to disable this"
  194. msg)
  195. (string-match "use \\([A-Z][A-Za-z]+\\)" msg)
  196. (string-match "You need \\([A-Z][A-Za-z]+\\)" msg)))
  197. (when haskell-process-suggest-language-pragmas
  198. (haskell-process-suggest-pragma
  199. session
  200. "LANGUAGE"
  201. (match-string 1 msg)
  202. file)))
  203. ((string-match
  204. " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant"
  205. msg)
  206. (when haskell-process-suggest-remove-import-lines
  207. (haskell-process-suggest-remove-import
  208. session
  209. file
  210. (match-string 2 msg)
  211. line)))
  212. ((string-match "[Ww]arning: orphan instance: " msg)
  213. (when haskell-process-suggest-no-warn-orphans
  214. (haskell-process-suggest-pragma
  215. session
  216. "OPTIONS" "-fno-warn-orphans"
  217. file)))
  218. ((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg)
  219. (string-match "with actual type [‘`‛]\\[Char\\]['’]" msg))
  220. (when haskell-process-suggest-overloaded-strings
  221. (haskell-process-suggest-pragma
  222. session
  223. "LANGUAGE" "OverloadedStrings"
  224. file)))
  225. ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg)
  226. (let* ((match1 (match-string 1 msg))
  227. (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1)
  228. ;; Skip qualification.
  229. (match-string 1 match1)
  230. match1)))
  231. (when haskell-process-suggest-hoogle-imports
  232. (let ((modules (haskell-process-hoogle-ident ident)))
  233. (haskell-process-suggest-imports session file modules ident)))
  234. (when haskell-process-suggest-haskell-docs-imports
  235. (let ((modules (haskell-process-haskell-docs-ident ident)))
  236. (haskell-process-suggest-imports session file modules ident)))
  237. (when haskell-process-suggest-hayoo-imports
  238. (let ((modules (haskell-process-hayoo-ident ident)))
  239. (haskell-process-suggest-imports session file modules ident)))))
  240. ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\([^@\r\n]+\\).*['’].$" msg)
  241. (when haskell-process-suggest-add-package
  242. (haskell-process-suggest-add-package session msg)))))
  243. (defun haskell-process-do-cabal (command)
  244. "Run a Cabal command."
  245. (let ((process (ignore-errors
  246. (haskell-interactive-process))))
  247. (cond
  248. ((or (eq process nil)
  249. (let ((child (haskell-process-process process)))
  250. (not (equal 'run (process-status child)))))
  251. (message "Process is not running, so running directly.")
  252. (shell-command (concat "cabal " command)
  253. (get-buffer-create "*haskell-process-log*")
  254. (get-buffer-create "*haskell-process-log*"))
  255. (switch-to-buffer-other-window (get-buffer "*haskell-process-log*")))
  256. (t (haskell-process-queue-command
  257. process
  258. (make-haskell-command
  259. :state (list (haskell-interactive-session) process command 0)
  260. :go
  261. (lambda (state)
  262. (haskell-process-send-string
  263. (cadr state)
  264. (format haskell-process-do-cabal-format-string
  265. (haskell-session-cabal-dir (car state))
  266. (format "%s %s"
  267. (cl-ecase (haskell-process-type)
  268. ('ghci haskell-process-path-cabal)
  269. ('cabal-repl haskell-process-path-cabal)
  270. ('cabal-new-repl haskell-process-path-cabal)
  271. ('cabal-ghci haskell-process-path-cabal)
  272. ('stack-ghci haskell-process-path-stack))
  273. (cl-caddr state)))))
  274. :live
  275. (lambda (state buffer)
  276. (let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*"
  277. "\\1"
  278. (cl-caddr state))))
  279. (cond ((or (string= cmd "build")
  280. (string= cmd "install"))
  281. (haskell-process-live-build (cadr state) buffer t))
  282. (t
  283. (haskell-process-cabal-live state buffer)))))
  284. :complete
  285. (lambda (state response)
  286. (let* ((process (cadr state))
  287. (session (haskell-process-session process))
  288. (message-count 0)
  289. (cursor (haskell-process-response-cursor process)))
  290. ;; XXX: what the hell about the rampant code duplication?
  291. (haskell-process-set-response-cursor process 0)
  292. (while (haskell-process-errors-warnings nil session process response)
  293. (setq message-count (1+ message-count)))
  294. (haskell-process-set-response-cursor process cursor)
  295. (let ((msg (format "Complete: cabal %s (%s compiler messages)"
  296. (cl-caddr state)
  297. message-count)))
  298. (haskell-interactive-mode-echo session msg)
  299. (when (= message-count 0)
  300. (haskell-interactive-mode-echo
  301. session
  302. "No compiler messages, dumping complete output:")
  303. (haskell-interactive-mode-echo session response))
  304. (haskell-mode-message-line msg)
  305. (when (and haskell-notify-p
  306. (fboundp 'notifications-notify))
  307. (notifications-notify
  308. :title (format "*%s*" (haskell-session-name (car state)))
  309. :body msg
  310. :app-name (cl-ecase (haskell-process-type)
  311. ('ghci haskell-process-path-cabal)
  312. ('cabal-repl haskell-process-path-cabal)
  313. ('cabal-new-repl haskell-process-path-cabal)
  314. ('cabal-ghci haskell-process-path-cabal)
  315. ('stack-ghci haskell-process-path-stack))
  316. :app-icon haskell-process-logo)))))))))))
  317. (defun haskell-process-echo-load-message (process buffer echo-in-repl th)
  318. "Echo a load message."
  319. (let ((session (haskell-process-session process))
  320. (module-name (match-string 3 buffer))
  321. (file-name (match-string 4 buffer)))
  322. (haskell-interactive-show-load-message
  323. session
  324. 'compiling
  325. module-name
  326. (haskell-session-strip-dir session file-name)
  327. echo-in-repl
  328. th)))
  329. (defun haskell-process-extract-modules (buffer)
  330. "Extract the modules from the process buffer."
  331. (let* ((modules-string (match-string 1 buffer))
  332. (modules (and modules-string (split-string modules-string ", "))))
  333. (cons modules modules-string)))
  334. ;;;###autoload
  335. (defface haskell-error-face
  336. '((((supports :underline (:style wave)))
  337. :underline (:style wave :color "#dc322f"))
  338. (t
  339. :inherit error))
  340. "Face used for marking error lines."
  341. :group 'haskell-mode)
  342. ;;;###autoload
  343. (defface haskell-warning-face
  344. '((((supports :underline (:style wave)))
  345. :underline (:style wave :color "#b58900"))
  346. (t
  347. :inherit warning))
  348. "Face used for marking warning lines."
  349. :group 'haskell-mode)
  350. ;;;###autoload
  351. (defface haskell-hole-face
  352. '((((supports :underline (:style wave)))
  353. :underline (:style wave :color "#6c71c4"))
  354. (t
  355. :inherit warning))
  356. "Face used for marking hole lines."
  357. :group 'haskell-mode)
  358. (defvar haskell-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark)))
  359. (defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark)))
  360. (defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar)))
  361. (defun haskell-check-overlay-p (ovl)
  362. (overlay-get ovl 'haskell-check))
  363. (defun haskell-check-filter-overlays (xs)
  364. (cl-remove-if-not 'haskell-check-overlay-p xs))
  365. (defun haskell-check-remove-overlays (buffer)
  366. (with-current-buffer buffer
  367. (remove-overlays (point-min) (point-max) 'haskell-check t)))
  368. (defmacro haskell-with-overlay-properties (proplist ovl &rest body)
  369. "Evaluate BODY with names in PROPLIST bound to the values of
  370. correspondingly-named overlay properties of OVL."
  371. (let ((ovlvar (cl-gensym "OVL-")))
  372. `(let* ((,ovlvar ,ovl)
  373. ,@(mapcar (lambda (p) `(,p (overlay-get ,ovlvar ',p))) proplist))
  374. ,@body)))
  375. (defun haskell-overlay-start> (o1 o2)
  376. (> (overlay-start o1) (overlay-start o2)))
  377. (defun haskell-overlay-start< (o1 o2)
  378. (< (overlay-start o1) (overlay-start o2)))
  379. (defun haskell-first-overlay-in-if (test beg end)
  380. (let ((ovls (cl-remove-if-not test (overlays-in beg end))))
  381. (cl-first (sort (cl-copy-list ovls) 'haskell-overlay-start<))))
  382. (defun haskell-last-overlay-in-if (test beg end)
  383. (let ((ovls (cl-remove-if-not test (overlays-in beg end))))
  384. (cl-first (sort (cl-copy-list ovls) 'haskell-overlay-start>))))
  385. (defun haskell-error-overlay-briefly (ovl)
  386. (haskell-with-overlay-properties
  387. (haskell-msg haskell-msg-type) ovl
  388. (cond
  389. ((not (eq haskell-msg-type 'warning))
  390. haskell-msg)
  391. ((string-prefix-p "[Ww]arning:\n " haskell-msg)
  392. (cl-subseq haskell-msg 13))
  393. (t
  394. (error
  395. "Invariant failed: a warning message from GHC has unexpected form: %s."
  396. haskell-msg)))))
  397. (defun haskell-goto-error-overlay (ovl)
  398. (cond (ovl
  399. (goto-char (overlay-start ovl))
  400. (haskell-mode-message-line (haskell-error-overlay-briefly ovl)))
  401. (t
  402. (message "No further notes from Haskell compiler."))))
  403. (defun haskell-goto-first-error ()
  404. (interactive)
  405. (haskell-goto-error-overlay
  406. (haskell-first-overlay-in-if 'haskell-check-overlay-p
  407. (buffer-end 0) (buffer-end 1))))
  408. (defun haskell-goto-prev-error ()
  409. (interactive)
  410. (haskell-goto-error-overlay
  411. (let ((ovl-at
  412. (cl-first (haskell-check-filter-overlays (overlays-at (point))))))
  413. (or (haskell-last-overlay-in-if 'haskell-check-overlay-p
  414. (point-min)
  415. (if ovl-at (overlay-start ovl-at) (point)))
  416. ovl-at))))
  417. (defun haskell-goto-next-error ()
  418. (interactive)
  419. (haskell-goto-error-overlay
  420. (let ((ovl-at
  421. (cl-first (haskell-check-filter-overlays (overlays-at (point))))))
  422. (or (haskell-first-overlay-in-if
  423. 'haskell-check-overlay-p
  424. (if ovl-at (overlay-end ovl-at) (point)) (point-max))
  425. ovl-at))))
  426. (defun haskell-check-paint-overlay
  427. (buffer error-from-this-file-p line msg file type hole coln)
  428. (with-current-buffer buffer
  429. (let (beg end)
  430. (goto-char (point-min))
  431. ;; XXX: we can avoid excess buffer walking by relying on the maybe-fact
  432. ;; that GHC sorts error messages by line number, maybe.
  433. (cond
  434. (error-from-this-file-p
  435. (forward-line (1- line))
  436. (forward-char (1- coln))
  437. (setq beg (point))
  438. (if (eq type 'hole)
  439. (forward-char (length hole))
  440. (skip-chars-forward "^[:space:]" (line-end-position)))
  441. (setq end (point)))
  442. (t
  443. (setq beg (point))
  444. (forward-line)
  445. (setq end (point))))
  446. (let ((ovl (make-overlay beg end)))
  447. (overlay-put ovl 'haskell-check t)
  448. (overlay-put ovl 'haskell-file file)
  449. (overlay-put ovl 'haskell-msg msg)
  450. (overlay-put ovl 'haskell-msg-type type)
  451. (overlay-put ovl 'help-echo msg)
  452. (overlay-put ovl 'haskell-hole hole)
  453. (cl-destructuring-bind
  454. (face fringe)
  455. (cl-case type
  456. (warning
  457. (list 'haskell-warning-face haskell-check-warning-fringe))
  458. (hole
  459. (list 'haskell-hole-face haskell-check-hole-fringe))
  460. (error
  461. (list 'haskell-error-face haskell-check-error-fringe)))
  462. (overlay-put ovl 'before-string fringe)
  463. (overlay-put ovl 'face face))))))
  464. (defun haskell-process-errors-warnings
  465. (module-buffer session process buffer &optional return-only)
  466. "Trigger handling type errors or warnings.
  467. Either prints the messages in the interactive buffer or if CONT
  468. is specified, passes the error onto that.
  469. When MODULE-BUFFER is non-NIL, paint error overlays."
  470. (save-excursion
  471. (cond
  472. ((haskell-process-consume
  473. process
  474. "\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed")
  475. (let ((err (match-string 1 buffer)))
  476. (if (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err)
  477. (let* ((default-directory (haskell-session-current-dir session))
  478. (module (match-string 1 err))
  479. (file (match-string 2 err))
  480. (relative-file-name (file-relative-name file)))
  481. (unless return-only
  482. (haskell-interactive-show-load-message
  483. session
  484. 'import-cycle
  485. module
  486. relative-file-name
  487. nil
  488. nil)
  489. (haskell-interactive-mode-compile-error
  490. session
  491. (format "%s:1:0: %s"
  492. relative-file-name
  493. err)))
  494. (list :file file :line 1 :col 0 :msg err :type 'error))
  495. t)))
  496. ((haskell-process-consume
  497. process
  498. (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):"
  499. "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]"))
  500. (haskell-process-set-response-cursor
  501. process
  502. (- (haskell-process-response-cursor process) 1))
  503. (let* ((buffer (haskell-process-response process))
  504. (file (match-string 1 buffer))
  505. (location-raw (match-string 2 buffer))
  506. (error-msg (match-string 3 buffer))
  507. (type (cond ((string-match "^[Ww]arning:" error-msg) 'warning)
  508. ((string-match "^Splicing " error-msg) 'splice)
  509. (t 'error)))
  510. (critical (not (eq type 'warning)))
  511. ;; XXX: extract hole information, pass down to
  512. ;; `haskell-check-paint-overlay'
  513. (final-msg (format "%s:%s: %s"
  514. (haskell-session-strip-dir session file)
  515. location-raw
  516. error-msg))
  517. (location (haskell-process-parse-error
  518. (concat file ":" location-raw ": x")))
  519. (line (plist-get location :line))
  520. (col1 (plist-get location :col)))
  521. (when (and module-buffer haskell-process-show-overlays)
  522. (haskell-check-paint-overlay
  523. module-buffer
  524. (string= (file-truename (buffer-file-name module-buffer))
  525. (file-truename file))
  526. line error-msg file type nil col1))
  527. (if return-only
  528. (list :file file :line line :col col1 :msg error-msg :type type)
  529. (progn (funcall (cl-case type
  530. (warning 'haskell-interactive-mode-compile-warning)
  531. (splice 'haskell-interactive-mode-compile-splice)
  532. (error 'haskell-interactive-mode-compile-error))
  533. session final-msg)
  534. (when critical
  535. (haskell-mode-message-line final-msg))
  536. (haskell-process-trigger-suggestions
  537. session
  538. error-msg
  539. file
  540. line)
  541. t)))))))
  542. (defun haskell-interactive-show-load-message (session type module-name file-name echo th)
  543. "Show the '(Compiling|Loading) X' message."
  544. (let ((msg (concat
  545. (cl-ecase type
  546. ('compiling
  547. (if haskell-interactive-mode-include-file-name
  548. (format "Compiling: %s (%s)" module-name file-name)
  549. (format "Compiling: %s" module-name)))
  550. ('loading (format "Loading: %s" module-name))
  551. ('import-cycle
  552. (format "Module has an import cycle: %s" module-name)))
  553. (if th " [TH]" ""))))
  554. (haskell-mode-message-line msg)
  555. (when haskell-interactive-mode-delete-superseded-errors
  556. (haskell-interactive-mode-delete-compile-messages session file-name))
  557. (when echo
  558. (haskell-interactive-mode-echo session msg))))
  559. ;;;###autoload
  560. (defun haskell-process-reload-devel-main ()
  561. "Reload the module `DevelMain' and then run `DevelMain.update'.
  562. This is for doing live update of the code of servers or GUI
  563. applications. Put your development version of the program in
  564. `DevelMain', and define `update' to auto-start the program on a
  565. new thread, and use the `foreign-store' package to access the
  566. running context across :load/:reloads in GHCi."
  567. (interactive)
  568. (haskell-mode-toggle-interactive-prompt-state)
  569. (unwind-protect
  570. (with-current-buffer
  571. (or (get-buffer "DevelMain.hs")
  572. (if (y-or-n-p
  573. "You need to open a buffer named DevelMain.hs. Find now?")
  574. (ido-find-file)
  575. (error "No DevelMain.hs buffer.")))
  576. (let ((session (haskell-interactive-session)))
  577. (let ((process (haskell-interactive-process)))
  578. (haskell-process-queue-command
  579. process
  580. (make-haskell-command
  581. :state (list :session session
  582. :process process
  583. :buffer (current-buffer))
  584. :go (lambda (state)
  585. (haskell-process-send-string (plist-get state ':process)
  586. ":l DevelMain"))
  587. :live (lambda (state buffer)
  588. (haskell-process-live-build (plist-get state ':process)
  589. buffer
  590. nil))
  591. :complete (lambda (state response)
  592. (haskell-process-load-complete
  593. (plist-get state ':session)
  594. (plist-get state ':process)
  595. response
  596. nil
  597. (plist-get state ':buffer)
  598. (lambda (ok)
  599. (when ok
  600. (haskell-process-queue-without-filters
  601. (haskell-interactive-process)
  602. "DevelMain.update")
  603. (message "DevelMain updated."))))))))))
  604. (haskell-mode-toggle-interactive-prompt-state t)))
  605. (provide 'haskell-load)
  606. ;;; haskell-load.el ends here