;;; haskell.el --- Top-level Haskell package -*- lexical-binding: t -*-
|
|
|
|
;; Copyright © 2014 Chris Done. All rights reserved.
|
|
;; 2016 Arthur Fayzrakhmanov
|
|
|
|
;; This file 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, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This file 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:
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'haskell-mode)
|
|
(require 'haskell-hoogle)
|
|
(require 'haskell-process)
|
|
(require 'haskell-debug)
|
|
(require 'haskell-interactive-mode)
|
|
(require 'haskell-repl)
|
|
(require 'haskell-load)
|
|
(require 'haskell-commands)
|
|
(require 'haskell-modules)
|
|
(require 'haskell-string)
|
|
(require 'haskell-completions)
|
|
(require 'haskell-utils)
|
|
(require 'haskell-customize)
|
|
|
|
(defvar interactive-haskell-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "C-c C-l") 'haskell-process-load-file)
|
|
(define-key map (kbd "C-c C-r") 'haskell-process-reload)
|
|
(define-key map (kbd "C-c C-t") 'haskell-process-do-type)
|
|
(define-key map (kbd "C-c C-i") 'haskell-process-do-info)
|
|
(define-key map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag)
|
|
(define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear)
|
|
(define-key map (kbd "C-c C-c") 'haskell-process-cabal-build)
|
|
(define-key map (kbd "C-c C-v") 'haskell-cabal-visit-file)
|
|
(define-key map (kbd "C-c C-x") 'haskell-process-cabal)
|
|
(define-key map (kbd "C-c C-b") 'haskell-interactive-switch)
|
|
(define-key map (kbd "C-c C-z") 'haskell-interactive-switch)
|
|
map)
|
|
"Keymap for using `interactive-haskell-mode'.")
|
|
|
|
;;;###autoload
|
|
(define-minor-mode interactive-haskell-mode
|
|
"Minor mode for enabling haskell-process interaction."
|
|
:lighter " Interactive"
|
|
:keymap interactive-haskell-mode-map
|
|
(add-hook 'completion-at-point-functions
|
|
#'haskell-completions-sync-repl-completion-at-point
|
|
nil
|
|
t))
|
|
|
|
(make-obsolete 'haskell-process-completions-at-point
|
|
'haskell-completions-sync-repl-completion-at-point
|
|
"June 19, 2015")
|
|
|
|
(defun haskell-process-completions-at-point ()
|
|
"A `completion-at-point' function using the current haskell process."
|
|
(when (haskell-session-maybe)
|
|
(let ((process (haskell-process))
|
|
symbol-bounds)
|
|
(cond
|
|
;; ghci can complete module names, but it needs the "import "
|
|
;; string at the beginning
|
|
((looking-back (rx line-start
|
|
"import" (1+ space)
|
|
(? "qualified" (1+ space))
|
|
(group (? (char upper) ; modid
|
|
(* (char alnum ?' ?.)))))
|
|
(line-beginning-position))
|
|
(let ((text (match-string-no-properties 0))
|
|
(start (match-beginning 1))
|
|
(end (match-end 1)))
|
|
(list start end
|
|
(haskell-process-get-repl-completions process text))))
|
|
;; Complete OPTIONS, a completion list comes from variable
|
|
;; `haskell-ghc-supported-options'
|
|
((and (nth 4 (syntax-ppss))
|
|
(save-excursion
|
|
(let ((p (point)))
|
|
(and (search-backward "{-#" nil t)
|
|
(search-forward-regexp "\\_<OPTIONS\\(?:_GHC\\)?\\_>" p t))))
|
|
(looking-back
|
|
(rx symbol-start "-" (* (char alnum ?-)))
|
|
(line-beginning-position)))
|
|
(list (match-beginning 0) (match-end 0) haskell-ghc-supported-options))
|
|
;; Complete LANGUAGE, a list of completions comes from variable
|
|
;; `haskell-ghc-supported-extensions'
|
|
((and (nth 4 (syntax-ppss))
|
|
(save-excursion
|
|
(let ((p (point)))
|
|
(and (search-backward "{-#" nil t)
|
|
(search-forward-regexp "\\_<LANGUAGE\\_>" p t))))
|
|
(setq symbol-bounds (bounds-of-thing-at-point 'symbol)))
|
|
(list (car symbol-bounds) (cdr symbol-bounds)
|
|
haskell-ghc-supported-extensions))
|
|
((setq symbol-bounds (haskell-ident-pos-at-point))
|
|
(cl-destructuring-bind (start . end) symbol-bounds
|
|
(list start end
|
|
(haskell-process-get-repl-completions
|
|
process (buffer-substring-no-properties start end)))))))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-interactive-mode-return ()
|
|
"Handle the return key."
|
|
(interactive)
|
|
(cond
|
|
;; At a compile message, jump to the location of the error in the
|
|
;; source.
|
|
((haskell-interactive-at-compile-message)
|
|
(next-error-internal))
|
|
;; At the input prompt, handle the expression in the usual way.
|
|
((haskell-interactive-at-prompt)
|
|
(haskell-interactive-handle-expr))
|
|
;; At any other location in the buffer, copy the line to the
|
|
;; current prompt.
|
|
(t
|
|
(haskell-interactive-copy-to-prompt))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-session-kill (&optional leave-interactive-buffer)
|
|
"Kill the session process and buffer, delete the session.
|
|
0. Prompt to kill all associated buffers.
|
|
1. Kill the process.
|
|
2. Kill the interactive buffer unless LEAVE-INTERACTIVE-BUFFER is not given.
|
|
3. Walk through all the related buffers and set their haskell-session to nil.
|
|
4. Remove the session from the sessions list."
|
|
(interactive)
|
|
(haskell-mode-toggle-interactive-prompt-state)
|
|
(unwind-protect
|
|
(let* ((session (haskell-session))
|
|
(name (haskell-session-name session))
|
|
(also-kill-buffers
|
|
(and haskell-ask-also-kill-buffers
|
|
(y-or-n-p
|
|
(format "Killing `%s'. Also kill all associated buffers?"
|
|
name)))))
|
|
(haskell-kill-session-process session)
|
|
(unless leave-interactive-buffer
|
|
(kill-buffer (haskell-session-interactive-buffer session)))
|
|
(cl-loop for buffer in (buffer-list)
|
|
do (with-current-buffer buffer
|
|
(when (and (boundp 'haskell-session)
|
|
(string= (haskell-session-name haskell-session)
|
|
name))
|
|
(setq haskell-session nil)
|
|
(when also-kill-buffers
|
|
(kill-buffer)))))
|
|
(setq haskell-sessions
|
|
(cl-remove-if (lambda (session)
|
|
(string= (haskell-session-name session)
|
|
name))
|
|
haskell-sessions)))
|
|
(haskell-mode-toggle-interactive-prompt-state t)))
|
|
|
|
;;;###autoload
|
|
(defun haskell-interactive-kill ()
|
|
"Kill the buffer and (maybe) the session."
|
|
(interactive)
|
|
(when (eq major-mode 'haskell-interactive-mode)
|
|
(haskell-mode-toggle-interactive-prompt-state)
|
|
(unwind-protect
|
|
(when (and (boundp 'haskell-session)
|
|
haskell-session
|
|
(y-or-n-p "Kill the whole session?"))
|
|
(haskell-session-kill t)))
|
|
(haskell-mode-toggle-interactive-prompt-state t)))
|
|
|
|
(defun haskell-session-make (name)
|
|
"Make a Haskell session."
|
|
(when (haskell-session-lookup name)
|
|
(error "Session of name %s already exists!" name))
|
|
(let ((session (setq haskell-session
|
|
(list (cons 'name name)))))
|
|
(add-to-list 'haskell-sessions session)
|
|
(haskell-process-start session)
|
|
session))
|
|
|
|
(defun haskell-session-new-assume-from-cabal ()
|
|
"Prompt to create a new project based on a guess from the nearest Cabal file.
|
|
If `haskell-process-load-or-reload-prompt' is nil, accept `default'."
|
|
(let ((name (haskell-session-default-name)))
|
|
(unless (haskell-session-lookup name)
|
|
(haskell-mode-toggle-interactive-prompt-state)
|
|
(unwind-protect
|
|
(if (or (not haskell-process-load-or-reload-prompt)
|
|
(y-or-n-p (format "Start a new project named “%s”? " name)))
|
|
(haskell-session-make name))
|
|
(haskell-mode-toggle-interactive-prompt-state t)))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-session ()
|
|
"Get the Haskell session, prompt if there isn't one or fail."
|
|
(or (haskell-session-maybe)
|
|
(haskell-session-assign
|
|
(or (haskell-session-from-buffer)
|
|
(haskell-session-new-assume-from-cabal)
|
|
(haskell-session-choose)
|
|
(haskell-session-new)))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-interactive-switch ()
|
|
"Switch to the interactive mode for this session."
|
|
(interactive)
|
|
(let ((initial-buffer (current-buffer))
|
|
(buffer (haskell-session-interactive-buffer (haskell-session))))
|
|
(with-current-buffer buffer
|
|
(setq haskell-interactive-previous-buffer initial-buffer))
|
|
(unless (eq buffer (window-buffer))
|
|
(switch-to-buffer-other-window buffer))))
|
|
|
|
(defun haskell-session-new ()
|
|
"Make a new session."
|
|
(let ((name (read-from-minibuffer "Project name: " (haskell-session-default-name))))
|
|
(when (not (string= name ""))
|
|
(let ((session (haskell-session-lookup name)))
|
|
(haskell-mode-toggle-interactive-prompt-state)
|
|
(unwind-protect
|
|
(if session
|
|
(when
|
|
(y-or-n-p
|
|
(format "Session %s already exists. Use it?" name))
|
|
session)
|
|
(haskell-session-make name)))
|
|
(haskell-mode-toggle-interactive-prompt-state t)))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-session-change ()
|
|
"Change the session for the current buffer."
|
|
(interactive)
|
|
(haskell-session-assign (or (haskell-session-new-assume-from-cabal)
|
|
(haskell-session-choose)
|
|
(haskell-session-new))))
|
|
|
|
(defun haskell-process-prompt-restart (process)
|
|
"Prompt to restart the died PROCESS."
|
|
(let ((process-name (haskell-process-name process))
|
|
(cursor-in-echo-area t))
|
|
(if haskell-process-suggest-restart
|
|
(progn
|
|
(haskell-mode-toggle-interactive-prompt-state)
|
|
(unwind-protect
|
|
(cond
|
|
((string-match "You need to re-run the 'configure' command."
|
|
(haskell-process-response process))
|
|
(cl-case (read-char-choice
|
|
(concat
|
|
"The Haskell process ended. Cabal wants you to run "
|
|
(propertize "cabal configure"
|
|
'face
|
|
'font-lock-keyword-face)
|
|
" because there is a version mismatch. Re-configure (y, n, l: view log)?"
|
|
"\n\n"
|
|
"Cabal said:\n\n"
|
|
(propertize (haskell-process-response process)
|
|
'face
|
|
'font-lock-comment-face))
|
|
'(?l ?n ?y))
|
|
(?y (let ((default-directory
|
|
(haskell-session-cabal-dir
|
|
(haskell-process-session process))))
|
|
(message "%s"
|
|
(shell-command-to-string "cabal configure"))))
|
|
(?l (let* ((response (haskell-process-response process))
|
|
(buffer (get-buffer "*haskell-process-log*")))
|
|
(if buffer
|
|
(switch-to-buffer buffer)
|
|
(progn (switch-to-buffer
|
|
(get-buffer-create "*haskell-process-log*"))
|
|
(insert response)))))
|
|
(?n)))
|
|
(t
|
|
(cl-case (read-char-choice
|
|
(propertize
|
|
(format "The Haskell process `%s' has died. Restart? (y, n, l: show process log) "
|
|
process-name)
|
|
'face
|
|
'minibuffer-prompt)
|
|
'(?l ?n ?y))
|
|
(?y (haskell-process-start (haskell-process-session process)))
|
|
(?l (let* ((response (haskell-process-response process))
|
|
(buffer (get-buffer "*haskell-process-log*")))
|
|
(if buffer
|
|
(switch-to-buffer buffer)
|
|
(progn (switch-to-buffer
|
|
(get-buffer-create "*haskell-process-log*"))
|
|
(insert response)))))
|
|
(?n))))
|
|
;; unwind
|
|
(haskell-mode-toggle-interactive-prompt-state t)))
|
|
(message "The Haskell process `%s' is dearly departed." process-name))))
|
|
|
|
(defun haskell-process ()
|
|
"Get the current process from the current session."
|
|
(haskell-session-process (haskell-session)))
|
|
|
|
;;;###autoload
|
|
(defun haskell-kill-session-process (&optional session)
|
|
"Kill the process."
|
|
(interactive)
|
|
(let* ((session (or session (haskell-session)))
|
|
(existing-process (get-process (haskell-session-name session))))
|
|
(when (processp existing-process)
|
|
(haskell-interactive-mode-echo session "Killing process ...")
|
|
(haskell-process-set (haskell-session-process session) 'is-restarting t)
|
|
(delete-process existing-process))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-interactive-mode-visit-error ()
|
|
"Visit the buffer of the current (or last) error message."
|
|
(interactive)
|
|
(with-current-buffer (haskell-session-interactive-buffer (haskell-session))
|
|
(if (progn (goto-char (line-beginning-position))
|
|
(looking-at haskell-interactive-mode-error-regexp))
|
|
(progn (forward-line -1)
|
|
(haskell-interactive-jump-to-error-line))
|
|
(progn (goto-char (point-max))
|
|
(haskell-interactive-mode-error-backward)
|
|
(haskell-interactive-jump-to-error-line)))))
|
|
|
|
(defvar xref-prompt-for-identifier nil)
|
|
|
|
;;;###autoload
|
|
(defun haskell-mode-jump-to-tag (&optional next-p)
|
|
"Jump to the tag of the given identifier.
|
|
|
|
Give optional NEXT-P parameter to override value of
|
|
`xref-prompt-for-identifier' during definition search."
|
|
(interactive "P")
|
|
(let ((ident (haskell-string-drop-qualifier (haskell-ident-at-point)))
|
|
(tags-file-dir (haskell-cabal--find-tags-dir))
|
|
(tags-revert-without-query t))
|
|
(when (and ident
|
|
(not (string= "" (haskell-string-trim ident)))
|
|
tags-file-dir)
|
|
(let ((tags-file-name (concat tags-file-dir "TAGS")))
|
|
(cond ((file-exists-p tags-file-name)
|
|
(let ((xref-prompt-for-identifier next-p))
|
|
(xref-find-definitions ident)))
|
|
(t (haskell-mode-generate-tags ident)))))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-mode-after-save-handler ()
|
|
"Function that will be called after buffer's saving."
|
|
(when haskell-tags-on-save
|
|
(ignore-errors (haskell-mode-generate-tags))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-mode-tag-find (&optional _next-p)
|
|
"The tag find function, specific for the particular session."
|
|
(interactive "P")
|
|
(cond
|
|
((elt (syntax-ppss) 3) ;; Inside a string
|
|
(haskell-mode-jump-to-filename-in-string))
|
|
(t (call-interactively 'haskell-mode-jump-to-tag))))
|
|
|
|
(defun haskell-mode-jump-to-filename-in-string ()
|
|
"Jump to the filename in the current string."
|
|
(let* ((string (save-excursion
|
|
(buffer-substring-no-properties
|
|
(1+ (search-backward-regexp "\"" (line-beginning-position) nil 1))
|
|
(1- (progn (forward-char 1)
|
|
(search-forward-regexp "\"" (line-end-position) nil 1))))))
|
|
(fp (expand-file-name string
|
|
(haskell-session-cabal-dir (haskell-session)))))
|
|
(find-file
|
|
(read-file-name
|
|
""
|
|
fp
|
|
fp))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-interactive-bring ()
|
|
"Bring up the interactive mode for this session."
|
|
(interactive)
|
|
(let* ((session (haskell-session))
|
|
(buffer (haskell-session-interactive-buffer session)))
|
|
(pop-to-buffer buffer)))
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-load-file ()
|
|
"Load the current buffer file."
|
|
(interactive)
|
|
(save-buffer)
|
|
(haskell-interactive-mode-reset-error (haskell-session))
|
|
(haskell-process-file-loadish (format "load \"%s\"" (replace-regexp-in-string
|
|
"\""
|
|
"\\\\\""
|
|
(buffer-file-name)))
|
|
nil
|
|
(current-buffer)))
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-reload ()
|
|
"Re-load the current buffer file."
|
|
(interactive)
|
|
(save-buffer)
|
|
(haskell-interactive-mode-reset-error (haskell-session))
|
|
(haskell-process-file-loadish "reload" t (current-buffer)))
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-reload-file () (haskell-process-reload))
|
|
|
|
(make-obsolete 'haskell-process-reload-file 'haskell-process-reload
|
|
"2015-11-14")
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-load-or-reload (&optional toggle)
|
|
"Load or reload. Universal argument toggles which."
|
|
(interactive "P")
|
|
(if toggle
|
|
(progn (setq haskell-reload-p (not haskell-reload-p))
|
|
(message "%s (No action taken this time)"
|
|
(if haskell-reload-p
|
|
"Now running :reload."
|
|
"Now running :load <buffer-filename>.")))
|
|
(if haskell-reload-p (haskell-process-reload) (haskell-process-load-file))))
|
|
|
|
(make-obsolete 'haskell-process-load-or-reload 'haskell-process-load-file
|
|
"2015-11-14")
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-cabal-build ()
|
|
"Build the Cabal project."
|
|
(interactive)
|
|
(haskell-process-do-cabal "build")
|
|
(haskell-process-add-cabal-autogen))
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-cabal (p)
|
|
"Prompts for a Cabal command to run."
|
|
(interactive "P")
|
|
(if p
|
|
(haskell-process-do-cabal
|
|
(read-from-minibuffer "Cabal command (e.g. install): "))
|
|
(haskell-process-do-cabal
|
|
(funcall haskell-completing-read-function "Cabal command: "
|
|
(append haskell-cabal-commands
|
|
(list "build --ghc-options=-fforce-recomp"))))))
|
|
|
|
(defun haskell-process-file-loadish (command reload-p module-buffer)
|
|
"Run a loading-ish COMMAND that wants to pick up type errors\
|
|
and things like that. RELOAD-P indicates whether the notification
|
|
should say 'reloaded' or 'loaded'. MODULE-BUFFER may be used
|
|
for various things, but is optional."
|
|
(let ((session (haskell-session)))
|
|
(haskell-session-current-dir session)
|
|
(when haskell-process-check-cabal-config-on-load
|
|
(haskell-process-look-config-changes session))
|
|
(let ((process (haskell-process)))
|
|
(haskell-process-queue-command
|
|
process
|
|
(make-haskell-command
|
|
:state (list session process command reload-p module-buffer)
|
|
:go (lambda (state)
|
|
(haskell-process-send-string
|
|
(cadr state) (format ":%s" (cl-caddr state))))
|
|
:live (lambda (state buffer)
|
|
(haskell-process-live-build
|
|
(cadr state) buffer nil))
|
|
:complete (lambda (state response)
|
|
(haskell-process-load-complete
|
|
(car state)
|
|
(cadr state)
|
|
response
|
|
(cl-cadddr state)
|
|
(cl-cadddr (cdr state)))))))))
|
|
|
|
;;;###autoload
|
|
(defun haskell-process-minimal-imports ()
|
|
"Dump minimal imports."
|
|
(interactive)
|
|
(unless (> (save-excursion
|
|
(goto-char (point-min))
|
|
(haskell-navigate-imports-go)
|
|
(point))
|
|
(point))
|
|
(goto-char (point-min))
|
|
(haskell-navigate-imports-go))
|
|
(haskell-process-queue-sync-request (haskell-process)
|
|
":set -ddump-minimal-imports")
|
|
(haskell-process-load-file)
|
|
(insert-file-contents-literally
|
|
(concat (haskell-session-current-dir (haskell-session))
|
|
"/"
|
|
(haskell-guess-module-name-from-file-name (buffer-file-name))
|
|
".imports")))
|
|
|
|
(defun haskell-interactive-jump-to-error-line ()
|
|
"Jump to the error line."
|
|
(let ((orig-line (buffer-substring-no-properties (line-beginning-position)
|
|
(line-end-position))))
|
|
(and (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)\\(-[0-9]+\\)?:" orig-line)
|
|
(let* ((file (match-string 1 orig-line))
|
|
(line (match-string 2 orig-line))
|
|
(col (match-string 3 orig-line))
|
|
(session (haskell-interactive-session))
|
|
(cabal-path (haskell-session-cabal-dir session))
|
|
(src-path (haskell-session-current-dir session))
|
|
(cabal-relative-file (expand-file-name file cabal-path))
|
|
(src-relative-file (expand-file-name file src-path)))
|
|
(let ((file (cond ((file-exists-p cabal-relative-file)
|
|
cabal-relative-file)
|
|
((file-exists-p src-relative-file)
|
|
src-relative-file))))
|
|
(when file
|
|
(other-window 1)
|
|
(find-file file)
|
|
(haskell-interactive-bring)
|
|
(goto-char (point-min))
|
|
(forward-line (1- (string-to-number line)))
|
|
(goto-char (+ (point) (string-to-number col) -1))
|
|
(haskell-mode-message-line orig-line)
|
|
t))))))
|
|
|
|
(provide 'haskell)
|
|
;;; haskell.el ends here
|