17ee0e400b
After moving off of Meta, Dotfiles has a greater responsibility to manage configs. Vim, Tmux, and Emacs are now within Stow's purview.
262 lines
10 KiB
EmacsLisp
262 lines
10 KiB
EmacsLisp
;;; inf-haskell.el --- Interaction with an inferior Haskell process -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
|
;; Copyright (C) 2017 Vasantha Ganesh Kanniappan <vasanthaganesh.k@tuta.io>
|
|
|
|
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
|
;; Keywords: Haskell
|
|
|
|
;; 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:
|
|
|
|
;; A major mode for the buffer that holds the inferior process
|
|
|
|
;; Todo:
|
|
|
|
;; - Check out Shim for ideas.
|
|
;; - i-h-load-buffer and i-h-send-region.
|
|
|
|
;;; Code:
|
|
|
|
(require 'comint)
|
|
(require 'shell) ; For directory tracking.
|
|
(require 'etags)
|
|
(require 'haskell-compat)
|
|
(require 'compile)
|
|
(require 'haskell-decl-scan)
|
|
(require 'haskell-cabal)
|
|
(require 'haskell-customize)
|
|
(require 'cl-lib)
|
|
(require 'haskell-string)
|
|
|
|
;;;###autoload
|
|
(defgroup inferior-haskell nil
|
|
"Settings for REPL interaction via `inferior-haskell-mode'"
|
|
:link '(custom-manual "(haskell-mode)inferior-haskell-mode")
|
|
:prefix "inferior-haskell-"
|
|
:prefix "haskell-"
|
|
:group 'haskell)
|
|
|
|
(defcustom inferior-haskell-hook nil
|
|
"The hook that is called after starting inf-haskell."
|
|
:type 'hook)
|
|
|
|
(defun haskell-program-name-with-args ()
|
|
"Return the command with the arguments to start the repl based on the
|
|
directory structure."
|
|
(cl-ecase (haskell-process-type)
|
|
('ghci (cond ((eq system-type 'cygwin) (nconc "ghcii.sh"
|
|
haskell-process-args-ghci))
|
|
(t (nconc `(,haskell-process-path-ghci)
|
|
haskell-process-args-ghci))))
|
|
('cabal-repl (nconc `(,haskell-process-path-cabal
|
|
"repl")
|
|
haskell-process-args-cabal-repl))
|
|
('stack-ghci (nconc `(,haskell-process-path-stack
|
|
"ghci")
|
|
haskell-process-args-stack-ghci))))
|
|
|
|
(defconst inferior-haskell-info-xref-re
|
|
"-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?$")
|
|
|
|
(defconst inferior-haskell-module-re
|
|
"-- Defined in \\(.+\\)$"
|
|
"Regular expression for matching module names in :info.")
|
|
|
|
(defvar inferior-haskell-multiline-prompt-re
|
|
"^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*| "
|
|
"Regular expression for matching multiline prompt (the one inside :{ ... :} blocks).")
|
|
|
|
(defconst inferior-haskell-error-regexp-alist
|
|
`(;; Format of error messages used by GHCi.
|
|
("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n *\\)\\([Ww]arning\\)?"
|
|
1 2 4 ,@(if (fboundp 'compilation-fake-loc)
|
|
'((6) nil (5 '(face nil font-lock-multiline t)))))
|
|
;; Runtime exceptions, from ghci.
|
|
("^\\*\\*\\* Exception: \\(.+?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\)): .*"
|
|
1 ,@(if (fboundp 'compilation-fake-loc) '((2 . 4) (3 . 5)) '(2 3)))
|
|
;; GHCi uses two different forms for line/col ranges, depending on
|
|
;; whether it's all on the same line or not :-( In Emacs-23, I could use
|
|
;; explicitly numbered subgroups to merge the two patterns.
|
|
("^\\*\\*\\* Exception: \\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): .*"
|
|
1 2 ,(if (fboundp 'compilation-fake-loc) '(3 . 4) 3))
|
|
;; Info messages. Not errors per se.
|
|
,@(when (fboundp 'compilation-fake-loc)
|
|
`(;; Other GHCi patterns used in type errors.
|
|
("^[ \t]+at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
|
|
1 2 (3 . 4) 0)
|
|
;; Foo.hs:318:80:
|
|
;; Ambiguous occurrence `Bar'
|
|
;; It could refer to either `Bar', defined at Zork.hs:311:5
|
|
;; or `Bar', imported from Bars at Frob.hs:32:0-16
|
|
;; (defined at Location.hs:97:5)
|
|
("[ (]defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\))?$" 1 2 3 0)
|
|
("imported from .* at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
|
|
1 2 (3 . 4) 0)
|
|
;; Info xrefs.
|
|
(,inferior-haskell-info-xref-re 1 2 (3 . 4) 0))))
|
|
"Regexps for error messages generated by inferior Haskell processes.
|
|
The format should be the same as for `compilation-error-regexp-alist'.")
|
|
|
|
(defconst haskell-prompt-regexp
|
|
;; Why the backslash in [\\._[:alnum:]]?
|
|
"^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*\\( λ\\)?> \\|^λ?> $")
|
|
|
|
;;; TODO
|
|
;;; -> Make font lock work for strings, directories, hyperlinks
|
|
;;; -> Make font lock work for key words???
|
|
|
|
(defvar inf-haskell-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map "\C-c\C-d" 'comint-kill-subjob)
|
|
map))
|
|
|
|
(defvaralias 'inferior-haskell-mode-map 'inf-haskell-map)
|
|
|
|
(define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
|
|
"Major mode for interacting with an inferior Haskell process."
|
|
:group 'inferior-haskell
|
|
(setq-local comint-prompt-regexp haskell-prompt-regexp)
|
|
|
|
(setq-local paragraph-start haskell-prompt-regexp)
|
|
|
|
(setq-local comint-input-autoexpand nil)
|
|
(setq-local comint-prompt-read-only t)
|
|
|
|
;; Setup directory tracking.
|
|
(setq-local shell-cd-regexp ":cd")
|
|
(condition-case nil
|
|
(shell-dirtrack-mode 1)
|
|
(error ;The minor mode function may not exist or not accept an arg.
|
|
(setq-local shell-dirtrackp t)
|
|
(add-hook 'comint-input-filter-functions 'shell-directory-tracker
|
|
nil 'local)))
|
|
|
|
;; Setup `compile' support so you can just use C-x ` and friends.
|
|
(setq-local compilation-error-regexp-alist inferior-haskell-error-regexp-alist)
|
|
(setq-local compilation-first-column 0) ;GHCI counts from 0.
|
|
(if (and (not (boundp 'minor-mode-overriding-map-alist))
|
|
(fboundp 'compilation-shell-minor-mode))
|
|
;; If we can't remove compilation-minor-mode bindings, at least try to
|
|
;; use compilation-shell-minor-mode, so there are fewer
|
|
;; annoying bindings.
|
|
(compilation-shell-minor-mode 1)
|
|
;; Else just use compilation-minor-mode but without its bindings because
|
|
;; things like mouse-2 are simply too annoying.
|
|
(compilation-minor-mode 1)
|
|
(let ((map (make-sparse-keymap)))
|
|
(dolist (keys '([menu-bar] [follow-link]))
|
|
;; Preserve some of the bindings.
|
|
(define-key map keys (lookup-key compilation-minor-mode-map keys)))
|
|
(add-to-list 'minor-mode-overriding-map-alist
|
|
(cons 'compilation-minor-mode map))))
|
|
(add-hook 'inferior-haskell-hook 'inferior-haskell-init))
|
|
|
|
(defvar inferior-haskell-buffer nil
|
|
"The buffer in which the inferior process is running.")
|
|
|
|
(defun inferior-haskell-start-process ()
|
|
"Start an inferior haskell process.
|
|
With universal prefix \\[universal-argument], prompts for a COMMAND,
|
|
otherwise uses `haskell-program-name-with-args'.
|
|
It runs the hook `inferior-haskell-hook' after starting the process and
|
|
setting up the inferior-haskell buffer."
|
|
(let ((command (haskell-program-name-with-args)))
|
|
(setq default-directory inferior-haskell-root-dir)
|
|
(setq inferior-haskell-buffer
|
|
(apply 'make-comint "haskell" (car command) nil (cdr command)))
|
|
(with-current-buffer inferior-haskell-buffer
|
|
(inferior-haskell-mode)
|
|
(run-hooks 'inferior-haskell-hook))))
|
|
|
|
(defun inferior-haskell-process ()
|
|
"Restart if not present."
|
|
(cond ((and (buffer-live-p inferior-haskell-buffer)
|
|
(comint-check-proc inferior-haskell-buffer))
|
|
(get-buffer-process inferior-haskell-buffer))
|
|
(t (inferior-haskell-start-process)
|
|
(inferior-haskell-process))))
|
|
|
|
;;;###autoload
|
|
(defalias 'run-haskell 'switch-to-haskell)
|
|
;;;###autoload
|
|
(defun switch-to-haskell ()
|
|
"Show the inferior-haskell buffer. Start the process if needed."
|
|
(interactive)
|
|
(let ((proc (inferior-haskell-process)))
|
|
(pop-to-buffer-same-window (process-buffer proc))))
|
|
|
|
(defvar inferior-haskell-result-history nil)
|
|
|
|
(defvar haskell-next-input ""
|
|
"This is a temporary variable to store the intermediate results while
|
|
`accecpt-process-output' with `haskell-extract-exp'")
|
|
|
|
(defun haskell-extract-exp (str)
|
|
(setq haskell-next-input (concat haskell-next-input str))
|
|
(if (with-temp-buffer
|
|
(insert haskell-next-input)
|
|
(re-search-backward haskell-prompt-regexp nil t 1))
|
|
(progn
|
|
(push (substring haskell-next-input
|
|
0
|
|
(1- (with-temp-buffer
|
|
(insert haskell-next-input)
|
|
(re-search-backward haskell-prompt-regexp nil t 1))))
|
|
inferior-haskell-result-history)
|
|
(setq haskell-next-input ""))
|
|
""))
|
|
|
|
(defun inferior-haskell-no-result-return (strg)
|
|
(let ((proc (inferior-haskell-process)))
|
|
(with-local-quit
|
|
(progn
|
|
(add-to-list 'comint-preoutput-filter-functions
|
|
(lambda (output)
|
|
(haskell-extract-exp output)))
|
|
(process-send-string proc strg)
|
|
(accept-process-output proc)
|
|
(sit-for 0.1)
|
|
(setq comint-preoutput-filter-functions nil)))))
|
|
|
|
(defun inferior-haskell-get-result (inf-expr)
|
|
"Submit the expression `inf-expr' to ghci and read the result."
|
|
(let* ((times 5))
|
|
(inferior-haskell-no-result-return (concat inf-expr "\n"))
|
|
(while (and (> times 0)
|
|
(not (stringp (car inferior-haskell-result-history))))
|
|
(setq times (1- times))
|
|
(inferior-haskell-no-result-return (concat inf-expr "\n")))
|
|
(haskell-string-chomp (car inferior-haskell-result-history))))
|
|
|
|
(defun inferior-haskell-init ()
|
|
"The first thing run while initalizing inferior-haskell-buffer"
|
|
(with-local-quit
|
|
(with-current-buffer inferior-haskell-buffer
|
|
(process-send-string (inferior-haskell-process) "\n")
|
|
(accept-process-output (inferior-haskell-process))
|
|
(sit-for 0.1))))
|
|
|
|
(defvar haskell-set+c-p nil
|
|
"t if `:set +c` else nil")
|
|
|
|
(defun haskell-set+c ()
|
|
"set `:set +c` is not already set"
|
|
(if (not haskell-set+c-p)
|
|
(inferior-haskell-get-result ":set +c")))
|
|
|
|
(provide 'inf-haskell)
|
|
|
|
;;; inf-haskell.el ends here
|