;;; 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 ;; Author: Stefan Monnier ;; 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 . ;;; 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 (append (if (listp haskell-process-path-ghci) haskell-process-path-ghci (list 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