inf-haskell.el
1 ;;; inf-haskell.el --- Interaction with an inferior Haskell process. 2 3 ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> 6 ;; Keywords: Haskell 7 8 ;; This file is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation; either version 2, or (at your option) 11 ;; any later version. 12 13 ;; This file is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with GNU Emacs; see the file COPYING. If not, write to 20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 ;; Boston, MA 02111-1307, USA. 22 23 ;;; Commentary: 24 25 ;; The code is made of 2 parts: a major mode for the buffer that holds the 26 ;; inferior process's session and a minor mode for use in source buffers. 27 28 ;;; Code: 29 30 (require 'comint) 31 (require 'shell) ;For directory tracking. 32 (require 'compile) 33 (require 'haskell-mode) 34 (eval-when-compile (require 'cl)) 35 36 ;; Here I depart from the inferior-haskell- prefix. 37 ;; Not sure if it's a good idea. 38 (defcustom haskell-program-name 39 ;; Arbitrarily give preference to hugs over ghci. 40 (or (cond 41 ((not (fboundp 'executable-find)) nil) 42 ((executable-find "hugs") "hugs \"+.\"") 43 ((executable-find "ghci") "ghci")) 44 "hugs \"+.\"") 45 "The name of the command to start the inferior Haskell process. 46 The command can include arguments." 47 ;; Custom only supports the :options keyword for a few types, e.g. not 48 ;; for string. 49 ;; :options '("hugs \"+.\"" "ghci") 50 :group 'haskell 51 :type '(choice string (repeat string))) 52 53 (defconst inferior-haskell-info-xref-re 54 "\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$") 55 56 (defconst inferior-haskell-error-regexp-alist 57 ;; The format of error messages used by Hugs. 58 `(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3) 59 ;; Format of error messages used by GHCi. 60 ("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n +\\)\\(Warning\\)?" 61 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6)))) 62 ;; Info xrefs. 63 ,@(if (fboundp 'compilation-fake-loc) 64 `((,inferior-haskell-info-xref-re 65 1 2 3 0)))) 66 "Regexps for error messages generated by inferior Haskell processes. 67 The format should be the same as for `compilation-error-regexp-alist'.") 68 69 (define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell" 70 "Major mode for interacting with an inferior Haskell process." 71 (set (make-local-variable 'comint-prompt-regexp) 72 "^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ") 73 (set (make-local-variable 'comint-input-autoexpand) nil) 74 75 ;; Setup directory tracking. 76 (set (make-local-variable 'shell-cd-regexp) ":cd") 77 (condition-case nil 78 (shell-dirtrack-mode 1) 79 (error ;The minor mode function may not exist or not accept an arg. 80 (set (make-local-variable 'shell-dirtrackp) t) 81 (add-hook 'comint-input-filter-functions 'shell-directory-tracker 82 nil 'local))) 83 84 ;; Setup `compile' support so you can just use C-x ` and friends. 85 (set (make-local-variable 'compilation-error-regexp-alist) 86 inferior-haskell-error-regexp-alist) 87 (if (and (not (boundp 'minor-mode-overriding-map-alist)) 88 (fboundp 'compilation-shell-minor-mode)) 89 ;; If we can't remove compilation-minor-mode bindings, at least try to 90 ;; use compilation-shell-minor-mode, so there are fewer 91 ;; annoying bindings. 92 (compilation-shell-minor-mode 1) 93 ;; Else just use compilation-minor-mode but without its bindings because 94 ;; things like mouse-2 are simply too annoying. 95 (compilation-minor-mode 1) 96 (let ((map (make-sparse-keymap))) 97 (dolist (keys '([menu-bar] [follow-link])) 98 ;; Preserve some of the bindings. 99 (define-key map keys (lookup-key compilation-minor-mode-map keys))) 100 (add-to-list 'minor-mode-overriding-map-alist 101 (cons 'compilation-minor-mode map))))) 102 103 (defun inferior-haskell-string-to-strings (string &optional separator) 104 "Split the STRING into a list of strings. 105 The SEPARATOR regexp defaults to \"\\s-+\"." 106 (let ((sep (or separator "\\s-+")) 107 (i (string-match "[\"]" string))) 108 (if (null i) (split-string string sep) ; no quoting: easy 109 (append (unless (eq i 0) (split-string (substring string 0 i) sep)) 110 (let ((rfs (read-from-string string i))) 111 (cons (car rfs) 112 (inferior-haskell-string-to-strings 113 (substring string (cdr rfs)) sep))))))) 114 115 (defun inferior-haskell-command (arg) 116 (inferior-haskell-string-to-strings 117 (if (null arg) haskell-program-name 118 (read-string "Command to run haskell: " haskell-program-name)))) 119 120 (defvar inferior-haskell-buffer nil 121 "The buffer in which the inferior process is running.") 122 123 (defun inferior-haskell-start-process (command) 124 "Start an inferior haskell process. 125 With universal prefix \\[universal-argument], prompts for a command, 126 otherwise uses `haskell-program-name'. 127 It runs the hook `inferior-haskell-hook' after starting the process and 128 setting up the inferior-haskell buffer." 129 (interactive (list (inferior-haskell-command current-prefix-arg))) 130 (setq inferior-haskell-buffer 131 (apply 'make-comint "haskell" (car command) nil (cdr command))) 132 (with-current-buffer inferior-haskell-buffer 133 (inferior-haskell-mode) 134 (run-hooks 'inferior-haskell-hook))) 135 136 (defun inferior-haskell-process (&optional arg) 137 (or (if (buffer-live-p inferior-haskell-buffer) 138 (get-buffer-process inferior-haskell-buffer)) 139 (progn 140 (let ((current-prefix-arg arg)) 141 (call-interactively 'inferior-haskell-start-process)) 142 ;; Try again. 143 (inferior-haskell-process arg)))) 144 145 ;;;###autoload 146 (defalias 'run-haskell 'switch-to-haskell) 147 ;;;###autoload 148 (defun switch-to-haskell (&optional arg) 149 "Show the inferior-haskell buffer. Start the process if needed." 150 (interactive "P") 151 (let ((proc (inferior-haskell-process arg))) 152 (pop-to-buffer (process-buffer proc)))) 153 154 (eval-when-compile 155 (unless (fboundp 'with-selected-window) 156 (defmacro with-selected-window (win &rest body) 157 `(save-selected-window 158 (select-window ,win) 159 ,@body)))) 160 161 (defcustom inferior-haskell-wait-and-jump nil 162 "If non-nil, wait for file loading to terminate and jump to the error." 163 :type 'boolean 164 :group 'haskell) 165 166 (defun inferior-haskell-wait-for-prompt (proc) 167 "Wait until PROC sends us a prompt. 168 The process PROC should be associated to a comint buffer." 169 (with-current-buffer (process-buffer proc) 170 (while (progn 171 (goto-char comint-last-input-end) 172 (and (not (re-search-forward comint-prompt-regexp nil t)) 173 (accept-process-output proc)))))) 174 175 ;;;###autoload 176 (defun inferior-haskell-load-file (&optional reload) 177 "Pass the current buffer's file to the inferior haskell process." 178 (interactive) 179 (let ((file buffer-file-name) 180 (proc (inferior-haskell-process))) 181 (save-buffer) 182 (with-current-buffer (process-buffer proc) 183 ;; Not sure if it's useful/needed and if it actually works. 184 ;; (unless (equal (file-name-as-directory default-directory) 185 ;; (file-name-directory file)) 186 ;; (inferior-haskell-send-string 187 ;; proc (concat ":cd " (file-name-directory file) "\n"))) 188 (compilation-forget-errors) 189 (let ((parsing-end (marker-position (process-mark proc)))) 190 (inferior-haskell-send-command 191 proc (if reload ":reload" (concat ":load \"" file "\""))) 192 ;; Move the parsing-end marker after sending the command so 193 ;; that it doesn't point just to the insertion point. 194 ;; Otherwise insertion may move the marker (if done with 195 ;; insert-before-markers) and we'd then miss some errors. 196 (if (boundp 'compilation-parsing-end) 197 (if (markerp compilation-parsing-end) 198 (set-marker compilation-parsing-end parsing-end) 199 (setq compilation-parsing-end parsing-end)))) 200 (with-selected-window (display-buffer (current-buffer)) 201 (goto-char (point-max))) 202 (when inferior-haskell-wait-and-jump 203 (inferior-haskell-wait-for-prompt proc) 204 (ignore-errors ;Don't beep if there were no errors. 205 (next-error)))))) 206 207 (defun inferior-haskell-send-command (proc str) 208 (setq str (concat str "\n")) 209 (with-current-buffer (process-buffer proc) 210 (inferior-haskell-wait-for-prompt proc) 211 (goto-char (process-mark proc)) 212 (insert-before-markers str) 213 (move-marker comint-last-input-end (point)) 214 (comint-send-string proc str))) 215 216 (defun inferior-haskell-reload-file () 217 "Tell the inferior haskell process to reread the current buffer's file." 218 (interactive) 219 (inferior-haskell-load-file 'reload)) 220 221 (defun inferior-haskell-type (expr &optional insert-value) 222 "Query the haskell process for the type of the given expression. 223 If optional argument `insert-value' is non-nil, insert the type above point 224 in the buffer. This can be done interactively with the \\[universal-argument] prefix. 225 The returned info is cached for reuse by `haskell-doc-mode'." 226 (interactive 227 (let ((sym (haskell-ident-at-point))) 228 (list (read-string (if (> (length sym) 0) 229 (format "Show type of (default %s): " sym) 230 "Show type of: ") 231 nil nil sym) 232 current-prefix-arg))) 233 (if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")"))) 234 (let* ((proc (inferior-haskell-process)) 235 (type 236 (with-current-buffer (process-buffer proc) 237 (let ((parsing-end ; Remember previous spot. 238 (marker-position (process-mark proc)))) 239 (inferior-haskell-send-command proc (concat ":type " expr)) 240 ;; Find new point. 241 (goto-char (point-max)) 242 (inferior-haskell-wait-for-prompt proc) 243 ;; Back up to the previous end-of-line. 244 (end-of-line 0) 245 ;; Extract the type output 246 (buffer-substring-no-properties 247 (save-excursion (goto-char parsing-end) 248 (line-beginning-position 2)) 249 (point)))))) 250 (if (not (string-match (concat "\\`" (regexp-quote expr) "[ \t]+::[ \t]*") 251 type)) 252 (error "No type info: %s" type) 253 254 ;; Cache for reuse by haskell-doc. 255 (when (and (boundp 'haskell-doc-mode) haskell-doc-mode 256 (boundp 'haskell-doc-user-defined-ids) 257 ;; Haskell-doc only works for idents, not arbitrary expr. 258 (string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*::[ \t]*" 259 type)) 260 (let ((sym (match-string 1 type))) 261 (setq haskell-doc-user-defined-ids 262 (cons (cons sym (substring type (match-end 0))) 263 (remove-if (lambda (item) (equal (car item) sym)) 264 haskell-doc-user-defined-ids))))) 265 266 (if (interactive-p) (message type)) 267 (when insert-value 268 (beginning-of-line) 269 (insert type "\n")) 270 type))) 271 272 (defun inferior-haskell-info (sym) 273 "Query the haskell process for the info of the given expression." 274 (interactive 275 (let ((sym (haskell-ident-at-point))) 276 (list (read-string (if (> (length sym) 0) 277 (format "Show info of (default %s): " sym) 278 "Show info of: ") 279 nil nil sym)))) 280 (let ((proc (inferior-haskell-process))) 281 (with-current-buffer (process-buffer proc) 282 (let ((parsing-end ; Remember previous spot. 283 (marker-position (process-mark proc)))) 284 (inferior-haskell-send-command proc (concat ":info " sym)) 285 ;; Find new point. 286 (goto-char (point-max)) 287 (inferior-haskell-wait-for-prompt proc) 288 ;; Move to previous end-of-line 289 (end-of-line 0) 290 (let ((result 291 (buffer-substring-no-properties 292 (save-excursion (goto-char parsing-end) 293 (line-beginning-position 2)) 294 (point)))) 295 ;; Move back to end of process buffer 296 (goto-char (point-max)) 297 (if (interactive-p) (message "%s" result)) 298 result))))) 299 300 (defun inferior-haskell-find-definition (sym) 301 "Attempt to locate and jump to the definition of the given expression." 302 (interactive 303 (let ((sym (haskell-ident-at-point))) 304 (list (read-string (if (> (length sym) 0) 305 (format "Find definition of (default %s): " sym) 306 "Find definition of: ") 307 nil nil sym)))) 308 (let ((info (inferior-haskell-info sym))) 309 (if (not (string-match inferior-haskell-info-xref-re info)) 310 (error "No source information available") 311 (let ((file (match-string-no-properties 1 info)) 312 (line (string-to-number 313 (match-string-no-properties 2 info))) 314 (col (string-to-number 315 (match-string-no-properties 3 info)))) 316 (when file 317 ;; Push current location marker on the ring used by `find-tag' 318 (require 'etags) 319 (ring-insert find-tag-marker-ring (point-marker)) 320 (pop-to-buffer (find-file-noselect file)) 321 (when line 322 (goto-line line) 323 (when col (move-to-column col)))))))) 324 325 (provide 'inf-haskell) 326 327 ;; arch-tag: 61804287-63dd-4052-bc0e-90f691b34b40 328 ;;; inf-haskell.el ends here