diff --git a/Makefile b/Makefile
index be0c21f6c..9fe70eba8 100644
--- a/Makefile
+++ b/Makefile
@@ -10,35 +10,42 @@ SUBST_ATAT = sed -e 's/@@GIT_VERSION@@/$(GIT_VERSION)/g;s/@GIT_VERSION@/$(GIT_VE
ELFILES = \
ghc-core.el \
haskell-align-imports.el \
- haskell-c.el \
+ haskell-bot.el \
haskell-cabal.el \
+ haskell-c.el \
haskell-checkers.el \
+ haskell-collapse.el \
+ haskell-commands.el \
haskell-compat.el \
haskell-compile.el \
+ haskell-complete-module.el \
+ haskell-customize.el \
+ haskell-debug.el \
haskell-decl-scan.el \
haskell-doc.el \
+ haskell.el \
haskell-font-lock.el \
- haskell-indent.el \
haskell-indentation.el \
- haskell-collapse.el \
+ haskell-indent.el \
haskell-interactive-mode.el \
+ haskell-load.el \
haskell-menu.el \
haskell-mode.el \
haskell-move-nested.el \
haskell-navigate-imports.el \
haskell-package.el \
- haskell-complete-module.el \
+ haskell-presentation-mode.el \
haskell-process.el \
+ haskell-repl.el \
haskell-session.el \
haskell-show.el \
haskell-simple-indent.el \
haskell-sort-imports.el \
- haskell-string.el \
haskell-str.el \
+ haskell-string.el \
haskell-unicode-input-method.el \
haskell-utils.el \
haskell-yas.el \
- haskell-presentation-mode.el \
inf-haskell.el
ELCFILES = $(ELFILES:.el=.elc)
diff --git a/gen-graph.sh b/gen-graph.sh
new file mode 100644
index 000000000..74ded651d
--- /dev/null
+++ b/gen-graph.sh
@@ -0,0 +1,12 @@
+echo "digraph {"
+echo "rankdir=TB;"
+for i in $(ls *.el | grep ^haskell)
+do
+
+ for x in $(egrep -o "^\\(require '([^)]+)" $i | sed "s/.require '//" | grep ^haskell)
+ do
+ z=$(echo $i | sed 's/.el$//')
+ echo "\"$z\" -> \"$x\"; "
+ done
+done
+echo "}"
diff --git a/haskell-bot.el b/haskell-bot.el
index 6969d9413..30cff1474 100644
--- a/haskell-bot.el
+++ b/haskell-bot.el
@@ -70,6 +70,8 @@
;;; Code:
+(require 'comint)
+
(defgroup haskell-bot nil
"Major mode for interacting with an inferior Bot session."
:group 'haskell
diff --git a/haskell-commands.el b/haskell-commands.el
new file mode 100644
index 000000000..c9c2f8bef
--- /dev/null
+++ b/haskell-commands.el
@@ -0,0 +1,754 @@
+;;; haskell-commands.el --- Commands that can be run on the process
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; 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 .
+
+;;; Code:
+
+(require 'haskell-process)
+(require 'haskell-font-lock)
+(require 'haskell-interactive-mode)
+(require 'haskell-session)
+
+(defun haskell-process-restart ()
+ "Restart the inferior Haskell process."
+ (interactive)
+ (haskell-process-reset (haskell-interactive-process))
+ (haskell-process-set (haskell-interactive-process) 'command-queue nil)
+ (haskell-process-start (haskell-interactive-session)))
+
+(defun haskell-process-start (session)
+ "Start the inferior Haskell process."
+ (let ((existing-process (get-process (haskell-session-name (haskell-interactive-session)))))
+ (when (processp existing-process)
+ (haskell-interactive-mode-echo session "Restarting process ...")
+ (haskell-process-set (haskell-session-process session) 'is-restarting t)
+ (delete-process existing-process)))
+ (let ((process (or (haskell-session-process session)
+ (haskell-process-make (haskell-session-name session))))
+ (old-queue (haskell-process-get (haskell-session-process session)
+ 'command-queue)))
+ (haskell-session-set-process session process)
+ (haskell-process-set-session process session)
+ (haskell-process-set-cmd process nil)
+ (haskell-process-set (haskell-session-process session) 'is-restarting nil)
+ (let ((default-directory (haskell-session-cabal-dir session)))
+ (haskell-session-pwd session)
+ (haskell-process-set-process
+ process
+ (cl-ecase (haskell-process-type)
+ ('ghci
+ (haskell-process-log
+ (propertize (format "Starting inferior GHCi process %s ..."
+ haskell-process-path-ghci)
+ 'face font-lock-comment-face))
+ (apply #'start-process
+ (append (list (haskell-session-name session)
+ nil
+ haskell-process-path-ghci)
+ haskell-process-args-ghci)))
+ ('cabal-repl
+ (haskell-process-log
+ (propertize
+ (format "Starting inferior `cabal repl' process using %s ..."
+ haskell-process-path-cabal)
+ 'face font-lock-comment-face))
+
+ (apply #'start-process
+ (append (list (haskell-session-name session)
+ nil
+ haskell-process-path-cabal)
+ '("repl") haskell-process-args-cabal-repl
+ (let ((target (haskell-session-target session)))
+ (if target (list target) nil)))))
+ ('cabal-ghci
+ (haskell-process-log
+ (propertize
+ (format "Starting inferior cabal-ghci process using %s ..."
+ haskell-process-path-cabal-ghci)
+ 'face font-lock-comment-face))
+ (start-process (haskell-session-name session)
+ nil
+ haskell-process-path-cabal-ghci))
+ ('cabal-dev
+ (let ((dir (concat (haskell-session-cabal-dir session)
+ "/cabal-dev")))
+ (haskell-process-log
+ (propertize (format "Starting inferior cabal-dev process %s -s %s ..."
+ haskell-process-path-cabal-dev
+ dir)
+ 'face font-lock-comment-face))
+ (start-process (haskell-session-name session)
+ nil
+ haskell-process-path-cabal-dev
+ "ghci"
+ "-s"
+ dir))))))
+ (progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel)
+ (set-process-filter (haskell-process-process process) 'haskell-process-filter))
+ (haskell-process-send-startup process)
+ (unless (eq 'cabal-repl (haskell-process-type)) ;; "cabal repl" sets the proper CWD
+ (haskell-process-change-dir session
+ process
+ (haskell-session-current-dir session)))
+ (haskell-process-set process 'command-queue
+ (append (haskell-process-get (haskell-session-process session)
+ 'command-queue)
+ old-queue))
+ process))
+
+(defun haskell-process-send-startup (process)
+ "Send the necessary start messages."
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state process
+
+ :go (lambda (process)
+ (haskell-process-send-string process ":set prompt \"\\4\"")
+ (haskell-process-send-string process "Prelude.putStrLn \"\"")
+ (haskell-process-send-string process ":set -v1"))
+
+ :live (lambda (process buffer)
+ (when (haskell-process-consume
+ process
+ "^\*\*\* WARNING: \\(.+\\) is writable by someone else, IGNORING!$")
+ (let ((path (match-string 1 buffer)))
+ (haskell-session-modify
+ (haskell-process-session process)
+ 'ignored-files
+ (lambda (files)
+ (cl-remove-duplicates (cons path files) :test 'string=)))
+ (haskell-interactive-mode-compile-warning
+ (haskell-process-session process)
+ (format "GHCi is ignoring: %s (run M-x haskell-process-unignore)"
+ path)))))
+
+ :complete (lambda (process _)
+ (haskell-interactive-mode-echo
+ (haskell-process-session process)
+ (concat (nth (random (length haskell-process-greetings))
+ haskell-process-greetings)
+ (when haskell-process-show-debug-tips
+ "
+If I break, you can:
+ 1. Restart: M-x haskell-process-restart
+ 2. Configure logging: C-h v haskell-process-log (useful for debugging)
+ 3. General config: M-x customize-mode
+ 4. Hide these tips: C-h v haskell-process-show-debug-tips")))))))
+
+(defun haskell-commands-process ()
+ "Get the Haskell session, throws an error if not available."
+ (or (haskell-session-process (haskell-session-maybe))
+ (error "No Haskell session/process associated with this
+ buffer. Maybe run M-x haskell-session-change?")))
+
+(defun haskell-process-clear ()
+ "Clear the current process."
+ (interactive)
+ (haskell-process-reset (haskell-commands-process))
+ (haskell-process-set (haskell-commands-process) 'command-queue nil))
+
+(defun haskell-process-interrupt ()
+ "Interrupt the process (SIGINT)."
+ (interactive)
+ (interrupt-process (haskell-process-process (haskell-commands-process))))
+
+(defun haskell-process-reload-with-fbytecode (process module-buffer)
+ "Reload FILE-NAME with -fbyte-code set, and then restore -fobject-code."
+ (haskell-process-queue-without-filters process ":set -fbyte-code")
+ (haskell-process-touch-buffer process module-buffer)
+ (haskell-process-queue-without-filters process ":reload")
+ (haskell-process-queue-without-filters process ":set -fobject-code"))
+
+(defun haskell-process-touch-buffer (process buffer)
+ "Updates mtime on the file for BUFFER by queing a touch on
+PROCESS."
+ (interactive)
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (cons process buffer)
+ :go (lambda (state)
+ (haskell-process-send-string
+ (car state)
+ (format ":!%s %s"
+ "touch"
+ (shell-quote-argument (buffer-file-name
+ (cdr state))))))
+ :complete (lambda (state _)
+ (with-current-buffer (cdr state)
+ (clear-visited-file-modtime))))))
+
+(defvar url-http-response-status)
+(defvar url-http-end-of-headers)
+
+(defun haskell-process-hayoo-ident (ident)
+ "Hayoo for IDENT, returns a list of modules asyncronously through CALLBACK."
+ ;; We need a real/simulated closure, because otherwise these
+ ;; variables will be unbound when the url-retrieve callback is
+ ;; called.
+ ;; TODO: Remove when this code is converted to lexical bindings by
+ ;; default (Emacs 24.1+)
+ (let ((url (format haskell-process-hayoo-query-url (url-hexify-string ident))))
+ (with-current-buffer (url-retrieve-synchronously url)
+ (if (= 200 url-http-response-status)
+ (progn
+ (goto-char url-http-end-of-headers)
+ (let* ((res (json-read))
+ (results (assoc-default 'result res)))
+ ;; TODO: gather packages as well, and when we choose a
+ ;; given import, check that we have the package in the
+ ;; cabal file as well.
+ (cl-mapcan (lambda (r)
+ ;; append converts from vector -> list
+ (append (assoc-default 'resultModules r) nil))
+ results)))
+ (warn "HTTP error %s fetching %s" url-http-response-status url)))))
+
+(defun haskell-process-hoogle-ident (ident)
+ "Hoogle for IDENT, returns a list of modules."
+ (with-temp-buffer
+ (let ((hoogle-error (call-process "hoogle" nil t nil "search" "--exact" ident)))
+ (goto-char (point-min))
+ (unless (or (/= 0 hoogle-error)
+ (looking-at "^No results found")
+ (looking-at "^package "))
+ (while (re-search-forward "^\\([^ ]+\\).*$" nil t)
+ (replace-match "\\1" nil nil))
+ (cl-remove-if (lambda (a) (string= "" a))
+ (split-string (buffer-string)
+ "\n"))))))
+
+(defun haskell-process-haskell-docs-ident (ident)
+ "Search with haskell-docs for IDENT, returns a list of modules."
+ (cl-remove-if-not (lambda (a) (string-match "^[A-Z][A-Za-b0-9_'.]+$" a))
+ (split-string (shell-command-to-string (concat "haskell-docs --modules " ident))
+ "\n")))
+
+(defun haskell-process-import-modules (process modules)
+ "Import `modules' with :m +, and send any import statements
+from `module-buffer'."
+ (when haskell-process-auto-import-loaded-modules
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (cons process modules)
+ :go (lambda (state)
+ (haskell-process-send-string
+ (car state)
+ (format ":m + %s" (mapconcat 'identity (cdr state) " "))))))))
+
+(defun haskell-describe (ident)
+ "Describe the given identifier."
+ (interactive (list (read-from-minibuffer "Describe identifier: "
+ (haskell-ident-at-point))))
+ (let ((results (read (shell-command-to-string
+ (concat "haskell-docs --sexp "
+ ident)))))
+ (help-setup-xref (list #'haskell-describe ident)
+ (called-interactively-p 'interactive))
+ (save-excursion
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (if results
+ (cl-loop for result in results
+ do (insert (propertize ident 'font-lock-face
+ '((:inherit font-lock-type-face
+ :underline t)))
+ " is defined in "
+ (let ((module (cadr (assoc 'module result))))
+ (if module
+ (concat module " ")
+ ""))
+ (cadr (assoc 'package result))
+ "\n\n")
+ do (let ((type (cadr (assoc 'type result))))
+ (when type
+ (insert (haskell-fontify-as-mode type 'haskell-mode)
+ "\n")))
+ do (let ((args (cadr (assoc 'type results))))
+ (cl-loop for arg in args
+ do (insert arg "\n"))
+ (insert "\n"))
+ do (insert (cadr (assoc 'documentation result)))
+ do (insert "\n\n"))
+ (insert "No results for " ident)))))))
+
+(defun haskell-rgrep (&optional prompt)
+ "Grep the effective project for the symbol at point. Very
+useful for codebase navigation. Prompts for an arbitrary regexp
+given a prefix arg."
+ (interactive "P")
+ (let ((sym (if prompt
+ (read-from-minibuffer "Look for: ")
+ (haskell-ident-at-point))))
+ (rgrep sym
+ "*.hs" ;; TODO: common Haskell extensions.
+ (haskell-session-current-dir (haskell-interactive-session)))))
+
+;;;###autoload
+(defun haskell-process-do-info (&optional prompt-value)
+ "Print info on the identifier at point.
+If PROMPT-VALUE is non-nil, request identifier via mini-buffer."
+ (interactive "P")
+ (haskell-process-do-simple-echo
+ (let ((ident (if prompt-value
+ (read-from-minibuffer "Info: " (haskell-ident-at-point))
+ (haskell-ident-at-point)))
+ (modname (unless prompt-value
+ (haskell-utils-parse-import-statement-at-point))))
+ (if modname
+ (format ":browse! %s" modname)
+ (format (if (string-match "^[a-zA-Z_]" ident)
+ ":info %s"
+ ":info (%s)")
+ (or ident
+ (haskell-ident-at-point)))))
+ 'haskell-mode))
+
+;;;###autoload
+(defun haskell-process-do-type (&optional insert-value)
+ "Print the type of the given expression."
+ (interactive "P")
+ (if insert-value
+ (haskell-process-insert-type)
+ (haskell-process-do-simple-echo
+ (let ((ident (haskell-ident-at-point)))
+ ;; TODO: Generalize all these `string-match' of ident calls into
+ ;; one function.
+ (format (if (string-match "^[_[:lower:][:upper:]]" ident)
+ ":type %s"
+ ":type (%s)")
+ ident))
+ 'haskell-mode)))
+
+;;;###autoload
+(defun haskell-mode-jump-to-def-or-tag (&optional next-p)
+ "Jump to the definition (by consulting GHCi), or (fallback)
+jump to the tag.
+
+Remember: If GHCi is busy doing something, this will delay, but
+it will always be accurate, in contrast to tags, which always
+work but are not always accurate.
+
+If the definition or tag is found, the location from which you
+jumped will be pushed onto `find-tag-marker-ring', so you can
+return to that position with `pop-tag-mark'."
+ (interactive "P")
+ (let ((initial-loc (point-marker))
+ (loc (haskell-mode-find-def (haskell-ident-at-point))))
+ (if loc
+ (haskell-mode-handle-generic-loc loc)
+ (call-interactively 'haskell-mode-tag-find))
+ (unless (equal initial-loc (point-marker))
+ ;; Store position for return with `pop-tag-mark'
+ (ring-insert find-tag-marker-ring initial-loc))))
+
+;;;###autoload
+(defun haskell-mode-goto-loc ()
+ "Go to the location of the thing at point. Requires the :loc-at
+command from GHCi."
+ (interactive)
+ (let ((loc (haskell-mode-loc-at)))
+ (when loc
+ (find-file (expand-file-name (plist-get loc :path)
+ (haskell-session-cabal-dir (haskell-interactive-session))))
+ (goto-char (point-min))
+ (forward-line (1- (plist-get loc :start-line)))
+ (forward-char (plist-get loc :start-col)))))
+
+(defun haskell-process-insert-type ()
+ "Get the identifer at the point and insert its type, if
+possible, using GHCi's :type."
+ (let ((process (haskell-interactive-process))
+ (query (let ((ident (haskell-ident-at-point)))
+ (format (if (string-match "^[_[:lower:][:upper:]]" ident)
+ ":type %s"
+ ":type (%s)")
+ ident))))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list process query (current-buffer))
+ :go (lambda (state)
+ (haskell-process-send-string (nth 0 state)
+ (nth 1 state)))
+ :complete (lambda (state response)
+ (cond
+ ;; TODO: Generalize this into a function.
+ ((or (string-match "^Top level" response)
+ (string-match "^" response))
+ (message response))
+ (t
+ (with-current-buffer (nth 2 state)
+ (goto-char (line-beginning-position))
+ (insert (format "%s\n" (replace-regexp-in-string "\n$" "" response)))))))))))
+
+(defun haskell-mode-find-def (ident)
+ "Find definition location of identifier. Uses the GHCi process
+to find the location.
+
+Returns:
+
+ (library )
+ (file )
+ (module )
+"
+ (let ((reply (haskell-process-queue-sync-request
+ (haskell-interactive-process)
+ (format (if (string-match "^[a-zA-Z_]" ident)
+ ":info %s"
+ ":info (%s)")
+ ident))))
+ (let ((match (string-match "-- Defined \\(at\\|in\\) \\(.+\\)$" reply)))
+ (when match
+ (let ((defined (match-string 2 reply)))
+ (let ((match (string-match "\\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)$" defined)))
+ (cond
+ (match
+ (list 'file
+ (expand-file-name (match-string 1 defined)
+ (haskell-session-current-dir (haskell-interactive-session)))
+ (string-to-number (match-string 2 defined))
+ (string-to-number (match-string 3 defined))))
+ (t
+ (let ((match (string-match "`\\(.+?\\):\\(.+?\\)'$" defined)))
+ (if match
+ (list 'library
+ (match-string 1 defined)
+ (match-string 2 defined))
+ (let ((match (string-match "`\\(.+?\\)'$" defined)))
+ (if match
+ (list 'module
+ (match-string 1 defined))))))))))))))
+
+(defun haskell-mode-jump-to-def (ident)
+ "Jump to definition of identifier at point."
+ (interactive (list (haskell-ident-at-point)))
+ (let ((loc (haskell-mode-find-def ident)))
+ (when loc
+ (haskell-mode-handle-generic-loc loc))))
+
+(defun haskell-mode-handle-generic-loc (loc)
+ "Either jump to or display a generic location. Either a file or
+a library."
+ (cl-case (car loc)
+ (file (haskell-mode-jump-to-loc (cdr loc)))
+ (library (message "Defined in `%s' (%s)."
+ (elt loc 2)
+ (elt loc 1)))
+ (module (message "Defined in `%s'."
+ (elt loc 1)))))
+
+(defun haskell-mode-loc-at ()
+ "Get the location at point. Requires the :loc-at command from
+GHCi."
+ (let ((pos (or (when (region-active-p)
+ (cons (region-beginning)
+ (region-end)))
+ (haskell-ident-pos-at-point)
+ (cons (point)
+ (point)))))
+ (when pos
+ (let ((reply (haskell-process-queue-sync-request
+ (haskell-interactive-process)
+ (save-excursion
+ (format ":loc-at %s %d %d %d %d %s"
+ (buffer-file-name)
+ (progn (goto-char (car pos))
+ (line-number-at-pos))
+ (1+ (current-column)) ;; GHC uses 1-based columns.
+ (progn (goto-char (cdr pos))
+ (line-number-at-pos))
+ (1+ (current-column)) ;; GHC uses 1-based columns.
+ (buffer-substring-no-properties (car pos)
+ (cdr pos)))))))
+ (if reply
+ (if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
+ reply)
+ (list :path (match-string 1 reply)
+ :start-line (string-to-number (match-string 2 reply))
+ ;; ;; GHC uses 1-based columns.
+ :start-col (1- (string-to-number (match-string 3 reply)))
+ :end-line (string-to-number (match-string 4 reply))
+ ;; GHC uses 1-based columns.
+ :end-col (1- (string-to-number (match-string 5 reply))))
+ (error (propertize reply 'face 'compilation-error)))
+ (error (propertize "No reply. Is :loc-at supported?"
+ 'face 'compilation-error)))))))
+(defun haskell-mode-type-at ()
+ "Get the type of the thing at point. Requires the :type-at
+command from GHCi."
+ (let ((pos (or (when (region-active-p)
+ (cons (region-beginning)
+ (region-end)))
+ (haskell-ident-pos-at-point)
+ (cons (point)
+ (point)))))
+ (when pos
+ (replace-regexp-in-string
+ "\n$"
+ ""
+ (save-excursion
+ (haskell-process-queue-sync-request
+ (haskell-interactive-process)
+ (replace-regexp-in-string
+ "\n"
+ " "
+ (format ":type-at %s %d %d %d %d %s"
+ (buffer-file-name)
+ (progn (goto-char (car pos))
+ (line-number-at-pos))
+ (1+ (current-column))
+ (progn (goto-char (cdr pos))
+ (line-number-at-pos))
+ (1+ (current-column))
+ (buffer-substring-no-properties (car pos)
+ (cdr pos))))))))))
+
+(defun haskell-process-cd (&optional not-interactive)
+ "Change directory."
+ (interactive)
+ (let* ((session (haskell-interactive-session))
+ (dir (haskell-session-pwd session t)))
+ (haskell-process-log
+ (propertize (format "Changing directory to %s ...\n" dir)
+ 'face font-lock-comment-face))
+ (haskell-process-change-dir session
+ (haskell-interactive-process)
+ dir)))
+
+(defun haskell-session-pwd (session &optional change)
+ "Prompt for the current directory."
+ (or (unless change
+ (haskell-session-get session 'current-dir))
+ (progn (haskell-session-set-current-dir
+ session
+ (haskell-utils-read-directory-name
+ (if change "Change directory: " "Set current directory: ")
+ (or (haskell-session-get session 'current-dir)
+ (haskell-session-get session 'cabal-dir)
+ (if (buffer-file-name)
+ (file-name-directory (buffer-file-name))
+ "~/"))))
+ (haskell-session-get session 'current-dir))))
+
+(defun haskell-process-change-dir (session process dir)
+ "Change the directory of the current process."
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list session process dir)
+ :go
+ (lambda (state)
+ (haskell-process-send-string
+ (cadr state) (format ":cd %s" (cl-caddr state))))
+
+ :complete
+ (lambda (state _)
+ (haskell-session-set-current-dir (car state) (cl-caddr state))
+ (haskell-interactive-mode-echo (car state)
+ (format "Changed directory: %s"
+ (cl-caddr state)))))))
+
+(defun haskell-process-cabal-macros ()
+ "Send the cabal macros string."
+ (interactive)
+ (haskell-process-queue-without-filters (haskell-interactive-process)
+ ":set -optP-include -optPdist/build/autogen/cabal_macros.h"))
+
+(defun haskell-process-do-try-info (sym)
+ "Get info of `sym' and echo in the minibuffer."
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (cons process sym)
+ :go (lambda (state)
+ (haskell-process-send-string
+ (car state)
+ (if (string-match "^[A-Za-z_]" (cdr state))
+ (format ":info %s" (cdr state))
+ (format ":info (%s)" (cdr state)))))
+ :complete (lambda (state response)
+ (unless (or (string-match "^Top level" response)
+ (string-match "^" response))
+ (haskell-mode-message-line response)))))))
+
+(defun haskell-process-do-try-type (sym)
+ "Get type of `sym' and echo in the minibuffer."
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (cons process sym)
+ :go (lambda (state)
+ (haskell-process-send-string
+ (car state)
+ (if (string-match "^[A-Za-z_]" (cdr state))
+ (format ":type %s" (cdr state))
+ (format ":type (%s)" (cdr state)))))
+ :complete (lambda (state response)
+ (unless (or (string-match "^Top level" response)
+ (string-match "^" response))
+ (haskell-mode-message-line response)))))))
+
+(defun haskell-mode-show-type-at (&optional insert-value)
+ "Show the type of the thing at point."
+ (interactive "P")
+ (let ((ty (haskell-mode-type-at)))
+ (if insert-value
+ (progn (goto-char (line-beginning-position))
+ (insert (haskell-fontify-as-mode ty 'haskell-mode)
+ "\n"))
+ (message "%s" (haskell-fontify-as-mode ty 'haskell-mode)))))
+
+(defun haskell-process-generate-tags (&optional and-then-find-this-tag)
+ "Regenerate the TAGS table."
+ (interactive)
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (cons process and-then-find-this-tag)
+ :go (lambda (state)
+ (if (eq system-type 'windows-nt)
+ (haskell-process-send-string
+ (car state)
+ (format ":!powershell -Command \"& { cd %s ; hasktags -e -x (ls -fi *.hs -exclude \\\"#*#\\\" -name -r) ; exit }\""
+ (haskell-session-cabal-dir
+ (haskell-process-session (car state)))))
+ (haskell-process-send-string
+ (car state)
+ (format ":!cd %s && %s | %s | %s"
+ (haskell-session-cabal-dir
+ (haskell-process-session (car state)))
+ "find . -name '*.hs*'"
+ "grep -v '#'" ; To avoid Emacs back-up files. Yeah.
+ "xargs hasktags -e -x"))))
+ :complete (lambda (state response)
+ (when (cdr state)
+ (let ((tags-file-name
+ (haskell-session-tags-filename
+ (haskell-process-session (car state)))))
+ (find-tag (cdr state))))
+ (haskell-mode-message-line "Tags generated."))))))
+
+(defun haskell-process-add-cabal-autogen ()
+ "Add /dist/build/autogen/ to the ghci search
+path. This allows modules such as 'Path_...', generated by cabal,
+to be loaded by ghci."
+ (unless (eq 'cabal-repl (haskell-process-type)) ;; redundant with "cabal repl"
+ (let*
+ ((session (haskell-interactive-session))
+ (cabal-dir (haskell-session-cabal-dir session))
+ (ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir)))
+ (haskell-process-queue-without-filters
+ (haskell-interactive-process)
+ (format ":set -i%s" ghci-gen-dir)))))
+
+(defun haskell-process-unignore ()
+ "Unignore any files that were specified as being ignored by the
+ inferior GHCi process."
+ (interactive)
+ (let ((session (haskell-interactive-session))
+ (changed nil))
+ (if (null (haskell-session-get session
+ 'ignored-files))
+ (message "Nothing to unignore!")
+ (cl-loop for file in (haskell-session-get session
+ 'ignored-files)
+ do (cl-case (read-event
+ (propertize (format "Set permissions? %s (y, n, v: stop and view file)"
+ file)
+ 'face 'minibuffer-prompt))
+ (?y
+ (haskell-process-unignore-file session file)
+ (setq changed t))
+ (?v
+ (find-file file)
+ (cl-return))))
+ (when (and changed
+ (y-or-n-p "Restart GHCi process now? "))
+ (haskell-process-restart)))))
+
+(defun haskell-session-change-target (target)
+ "Set the build target for cabal repl"
+ (interactive "sNew build target:")
+ (let* ((session haskell-session)
+ (old-target (haskell-session-get session 'target)))
+ (when session
+ (haskell-session-set-target session target)
+ (when (and (not (string= old-target target))
+ (y-or-n-p "Target changed, restart haskell process?"))
+ (haskell-process-start session)))))
+
+(defun haskell-mode-stylish-buffer ()
+ "Apply stylish-haskell to the current buffer."
+ (interactive)
+ (let ((column (current-column))
+ (line (line-number-at-pos)))
+ (haskell-mode-buffer-apply-command "stylish-haskell")
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (goto-char (+ column (point)))))
+
+(defun haskell-mode-buffer-apply-command (cmd)
+ "Execute shell command CMD with current buffer as input and
+replace the whole buffer with the output. If CMD fails the buffer
+remains unchanged."
+ (set-buffer-modified-p t)
+ (let* ((chomp (lambda (str)
+ (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
+ (setq str (replace-match "" t t str)))
+ str))
+ (errout (lambda (fmt &rest args)
+ (let* ((warning-fill-prefix " "))
+ (display-warning cmd (apply 'format fmt args) :warning))))
+ (filename (buffer-file-name (current-buffer)))
+ (cmd-prefix (replace-regexp-in-string " .*" "" cmd))
+ (tmp-file (make-temp-file cmd-prefix))
+ (err-file (make-temp-file cmd-prefix))
+ (default-directory (if (and (boundp 'haskell-session)
+ haskell-session)
+ (haskell-session-cabal-dir haskell-session)
+ default-directory))
+ (errcode (with-temp-file tmp-file
+ (call-process cmd filename
+ (list (current-buffer) err-file) nil)))
+ (stderr-output
+ (with-temp-buffer
+ (insert-file-contents err-file)
+ (funcall chomp (buffer-substring-no-properties (point-min) (point-max)))))
+ (stdout-output
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (if (string= "" stderr-output)
+ (if (string= "" stdout-output)
+ (funcall errout
+ "Error: %s produced no output, leaving buffer alone" cmd)
+ (save-restriction
+ (widen)
+ ;; command successful, insert file with replacement to preserve
+ ;; markers.
+ (insert-file-contents tmp-file nil nil nil t)))
+ ;; non-null stderr, command must have failed
+ (funcall errout "%s failed: %s" cmd stderr-output))
+ (delete-file tmp-file)
+ (delete-file err-file)))
+
+(provide 'haskell-commands)
diff --git a/haskell-customize.el b/haskell-customize.el
new file mode 100644
index 000000000..f61771a7f
--- /dev/null
+++ b/haskell-customize.el
@@ -0,0 +1,316 @@
+;;; haskell-customize.el --- Customization settings
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; 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 .
+
+;;; Code:
+
+(with-no-warnings (require 'cl))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customization variables
+
+(defgroup haskell nil
+ "Major mode for editing Haskell programs."
+ :link '(custom-manual "(haskell-mode)")
+ :group 'languages
+ :prefix "haskell-")
+
+(defvar haskell-mode-pkg-base-dir (file-name-directory load-file-name)
+ "Package base directory of installed `haskell-mode'.
+Used for locating additional package data files.")
+
+(defcustom haskell-completing-read-function 'ido-completing-read
+ "Default function to use for completion."
+ :group 'haskell
+ :type '(choice
+ (function-item :tag "ido" :value ido-completing-read)
+ (function-item :tag "helm" :value helm--completing-read-default)
+ (function-item :tag "completing-read" :value completing-read)
+ (function :tag "Custom function")))
+
+(defcustom haskell-process-type
+ 'auto
+ "The inferior Haskell process type to use."
+ :type '(choice (const auto) (const ghci) (const cabal-repl) (const cabal-dev) (const cabal-ghci))
+ :group 'haskell-interactive)
+
+(defcustom haskell-ask-also-kill-buffers
+ t
+ "Ask whether to kill all associated buffers when a session
+ process is killed."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Configuration
+
+(defvar haskell-process-end-hook nil
+ "Hook for when the haskell process ends.")
+
+(defgroup haskell-interactive nil
+ "Settings for REPL interaction via `haskell-interactive-mode'"
+ :link '(custom-manual "(haskell-mode)haskell-interactive-mode")
+ :group 'haskell)
+
+(defcustom haskell-process-path-ghci
+ "ghci"
+ "The path for starting ghci."
+ :group 'haskell-interactive
+ :type '(choice string (repeat string)))
+
+(defcustom haskell-process-path-cabal
+ "cabal"
+ "Path to the `cabal' executable."
+ :group 'haskell-interactive
+ :type '(choice string (repeat string)))
+
+(defcustom haskell-process-path-cabal-ghci
+ "cabal-ghci"
+ "The path for starting cabal-ghci."
+ :group 'haskell-interactive
+ :type '(choice string (repeat string)))
+
+(defcustom haskell-process-path-cabal-dev
+ "cabal-dev"
+ "The path for starting cabal-dev."
+ :group 'haskell-interactive
+ :type '(choice string (repeat string)))
+
+(defcustom haskell-process-args-ghci
+ '("-ferror-spans")
+ "Any arguments for starting ghci."
+ :group 'haskell-interactive
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom haskell-process-args-cabal-repl
+ '("--ghc-option=-ferror-spans")
+ "Additional arguments to for `cabal repl' invocation.
+Note: The settings in `haskell-process-path-ghci' and
+`haskell-process-args-ghci' are not automatically reused as `cabal repl'
+currently invokes `ghc --interactive'. Use
+`--with-ghc=' if you want to use a different
+interactive GHC frontend; use `--ghc-option=' to
+pass additional flags to `ghc'."
+ :group 'haskell-interactive
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom haskell-process-do-cabal-format-string
+ ":!cd %s && %s"
+ "The way to run cabal comands. It takes two arguments -- the directory and the command.
+See `haskell-process-do-cabal' for more details."
+ :group 'haskell-interactive
+ :type 'string)
+
+(defcustom haskell-process-log
+ nil
+ "Enable debug logging to \"*haskell-process-log*\" buffer."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-show-debug-tips
+ t
+ "Show debugging tips when starting the process."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-notify-p
+ nil
+ "Notify using notifications.el (if loaded)?"
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-no-warn-orphans
+ t
+ "Suggest adding -fno-warn-orphans pragma to file when getting orphan warnings."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-hoogle-imports
+ nil
+ "Suggest to add import statements using Hoogle as a backend."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-hayoo-imports
+ nil
+ "Suggest to add import statements using Hayoo as a backend."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-hayoo-query-url
+ "http://hayoo.fh-wedel.de/json/?query=%s"
+ "Query url for json hayoo results."
+ :type 'string
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-haskell-docs-imports
+ nil
+ "Suggest to add import statements using haskell-docs as a backend."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-add-package
+ t
+ "Suggest to add packages to your .cabal file when Cabal says it
+is a member of the hidden package, blah blah."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-language-pragmas
+ t
+ "Suggest adding LANGUAGE pragmas recommended by GHC."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-remove-import-lines
+ nil
+ "Suggest removing import lines as warned by GHC."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-overloaded-strings
+ t
+ "Suggest adding OverloadedStrings pragma to file when getting type mismatches with [Char]."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-check-cabal-config-on-load
+ t
+ "Check changes cabal config on loading Haskell files and
+restart the GHCi process if changed.."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-prompt-restart-on-cabal-change
+ t
+ "Ask whether to restart the GHCi process when the Cabal file
+has changed?"
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-auto-import-loaded-modules
+ nil
+ "Auto import the modules reported by GHC to have been loaded?"
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-reload-with-fbytecode
+ nil
+ "When using -fobject-code, auto reload with -fbyte-code (and
+then restore the -fobject-code) so that all module info and
+imports become available?"
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-use-presentation-mode
+ nil
+ "Use presentation mode to show things like type info instead of
+ printing to the message area."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-process-suggest-restart
+ t
+ "Suggest restarting the process when it has died"
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-scroll-to-bottom
+ nil
+ "Scroll to bottom in the REPL always."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-popup-errors
+ t
+ "Popup errors in a separate buffer."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-collapse
+ nil
+ "Collapse printed results."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-types-for-show-ambiguous
+ t
+ "Show types when there's no Show instance or there's an
+ambiguous class constraint."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-eval-pretty
+ nil
+ "Print eval results that can be parsed as Show instances prettily. Requires sexp-show (on Hackage)."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defvar haskell-interactive-prompt "λ> "
+ "The prompt to use.")
+
+(defcustom haskell-interactive-mode-eval-mode
+ nil
+ "Use the given mode's font-locking to render some text."
+ :type '(choice function (const :tag "None" nil))
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-hide-multi-line-errors
+ nil
+ "Hide collapsible multi-line compile messages by default."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-delete-superseded-errors
+ t
+ "Whether to delete compile messages superseded by recompile/reloads."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+(defcustom haskell-interactive-mode-include-file-name
+ t
+ "Include the file name of the module being compiled when
+printing compilation messages."
+ :type 'boolean
+ :group 'haskell-interactive)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Accessor functions
+
+(defun haskell-process-type ()
+ "Return `haskell-process-type', or a guess if that variable is 'auto."
+ (if (eq 'auto haskell-process-type)
+ (if (locate-dominating-file
+ default-directory
+ (lambda (d)
+ (or (file-directory-p (expand-file-name ".cabal-sandbox" d))
+ (cl-find-if (lambda (f) (string-match-p ".\\.cabal\\'" f)) (directory-files d)))))
+ 'cabal-repl
+ 'ghci)
+ haskell-process-type))
+
+;;;###autoload
+(defun haskell-customize ()
+ "Browse the haskell customize sub-tree.
+This calls 'customize-browse' with haskell as argument and makes
+sure all haskell customize definitions have been loaded."
+ (interactive)
+ ;; make sure all modules with (defcustom ...)s are loaded
+ (mapc 'require
+ '(haskell-checkers haskell-compile haskell-doc haskell-font-lock haskell-indentation haskell-indent haskell-interactive-mode haskell-menu haskell-process haskell-yas inf-haskell))
+ (customize-browse 'haskell))
+
+(provide 'haskell-customize)
diff --git a/haskell-debug.el b/haskell-debug.el
index 71d3913ec..7beb96274 100644
--- a/haskell-debug.el
+++ b/haskell-debug.el
@@ -21,18 +21,10 @@
(require 'haskell-session)
(require 'haskell-process)
(require 'haskell-interactive-mode)
+(require 'haskell-font-lock)
-(defmacro haskell-debug-with-breakpoints (&rest body)
- "Breakpoints need to exist to start stepping."
- `(if (haskell-debug-get-breakpoints)
- ,@body
- (error "No breakpoints to step into!")))
-
-(defmacro haskell-debug-with-modules (&rest body)
- "Modules need to exist to do debugging stuff."
- `(if (haskell-debug-get-modules)
- ,@body
- (error "No modules loaded!")))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Configuration
(defgroup haskell-debug nil
"Settings for debugging support."
@@ -69,6 +61,9 @@
"Face for muteds."
:group 'haskell-debug)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mode
+
(define-derived-mode haskell-debug-mode
text-mode "Debug"
"Major mode for debugging Haskell via GHCi.")
@@ -83,24 +78,135 @@
(define-key haskell-debug-mode-map (kbd "n") 'haskell-debug/next)
(define-key haskell-debug-mode-map (kbd "RET") 'haskell-debug/select)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Globals
+
(defvar haskell-debug-history-cache nil
"Cache of the tracing history.")
(defvar haskell-debug-bindings-cache nil
"Cache of the current step's bindings.")
-(defun haskell-debug-session-debugging-p (session)
- "Does the session have a debugging buffer open?"
- (not (not (get-buffer (haskell-debug-buffer-name session)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Macros
-(defun haskell-debug ()
- "Start the debugger for the current Haskell (GHCi) session."
+(defmacro haskell-debug-with-breakpoints (&rest body)
+ "Breakpoints need to exist to start stepping."
+ `(if (haskell-debug-get-breakpoints)
+ ,@body
+ (error "No breakpoints to step into!")))
+
+(defmacro haskell-debug-with-modules (&rest body)
+ "Modules need to exist to do debugging stuff."
+ `(if (haskell-debug-get-modules)
+ ,@body
+ (error "No modules loaded!")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Interactive functions
+
+(defun haskell-debug/select ()
+ "Select whatever is at point."
(interactive)
- (let ((session (haskell-session)))
- (switch-to-buffer-other-window (haskell-debug-buffer-name session))
- (unless (eq major-mode 'haskell-debug-mode)
- (haskell-debug-mode)
- (haskell-debug-start session))))
+ (cond
+ ((get-text-property (point) 'break)
+ (let ((break (get-text-property (point) 'break)))
+ (haskell-debug-highlight (plist-get break :path)
+ (plist-get break :span))))
+ ((get-text-property (point) 'module)
+ (let ((break (get-text-property (point) 'module)))
+ (haskell-debug-highlight (plist-get break :path))))))
+
+(defun haskell-debug/abandon ()
+ "Abandon the current computation."
+ (interactive)
+ (haskell-debug-with-breakpoints
+ (haskell-process-queue-sync-request (haskell-debug-process) ":abandon")
+ (message "Computation abandoned.")
+ (setq haskell-debug-history-cache nil)
+ (setq haskell-debug-bindings-cache nil)
+ (haskell-debug/refresh)))
+
+(defun haskell-debug/continue ()
+ "Continue the current computation."
+ (interactive)
+ (haskell-debug-with-breakpoints
+ (haskell-process-queue-sync-request (haskell-debug-process) ":continue")
+ (message "Computation continued.")
+ (setq haskell-debug-history-cache nil)
+ (setq haskell-debug-bindings-cache nil)
+ (haskell-debug/refresh)))
+
+(defun haskell-debug/break-on-function ()
+ "Break on function IDENT."
+ (interactive)
+ (haskell-debug-with-modules
+ (let ((ident (read-from-minibuffer "Function: "
+ (haskell-ident-at-point))))
+ (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ (concat ":break "
+ ident))
+ (message "Breaking on function: %s" ident)
+ (haskell-debug/refresh))))
+
+(defun haskell-debug/start-step (expr)
+ "Start stepping EXPR."
+ (interactive (list (read-from-minibuffer "Expression to step through: ")))
+ (haskell-debug/step expr))
+
+(defun haskell-debug/breakpoint-numbers ()
+ "List breakpoint numbers."
+ (interactive)
+ (let ((breakpoints (mapcar (lambda (breakpoint)
+ (number-to-string (plist-get breakpoint :number)))
+ (haskell-debug-get-breakpoints))))
+ (if (null breakpoints)
+ (message "No breakpoints.")
+ (message "Breakpoint(s): %s"
+ (mapconcat #'identity
+ breakpoints
+ ", ")))))
+
+(defun haskell-debug/next ()
+ "Go to next step to inspect bindings."
+ (interactive)
+ (haskell-debug-with-breakpoints
+ (haskell-debug-navigate "forward")))
+
+(defun haskell-debug/previous ()
+ "Go to previous step to inspect the bindings."
+ (interactive)
+ (haskell-debug-with-breakpoints
+ (haskell-debug-navigate "back")))
+
+(defun haskell-debug/refresh ()
+ "Refresh the debugger buffer."
+ (interactive)
+ (with-current-buffer (haskell-debug-buffer-name (haskell-debug-session))
+ (let ((inhibit-read-only t)
+ (p (point)))
+ (erase-buffer)
+ (insert (propertize (concat "Debugging "
+ (haskell-session-name (haskell-debug-session))
+ "\n\n")
+ 'face `((:weight bold))))
+ (let ((modules (haskell-debug-get-modules))
+ (breakpoints (haskell-debug-get-breakpoints))
+ (context (haskell-debug-get-context))
+ (history (haskell-debug-get-history)))
+ (unless modules
+ (insert (propertize "You have to load a module to start debugging."
+ 'face
+ 'haskell-debug-warning-face)
+ "\n\n"))
+ (haskell-debug-insert-bindings modules breakpoints context)
+ (when modules
+ (haskell-debug-insert-current-context context history)
+ (haskell-debug-insert-breakpoints breakpoints))
+ (haskell-debug-insert-modules modules))
+ (insert "\n")
+ (goto-char (min (point-max) p)))))
(defun haskell-debug/delete ()
"Delete whatever's at the point."
@@ -111,7 +217,7 @@
(when (y-or-n-p (format "Delete breakpoint #%d?"
(plist-get break :number)))
(haskell-process-queue-sync-request
- (haskell-process)
+ (haskell-debug-process)
(format ":delete %d"
(plist-get break :number)))
(haskell-debug/refresh))))))
@@ -124,7 +230,7 @@
(context (haskell-debug-get-context))
(string
(haskell-process-queue-sync-request
- (haskell-process)
+ (haskell-debug-process)
(if expr
(concat ":step " expr)
":step"))))
@@ -137,8 +243,8 @@
(t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string)))
(cond
(maybe-stopped-at
- (set (make-local-variable 'haskell-debug-bindings-cache)
- maybe-stopped-at)
+ (setq haskell-debug-bindings-cache
+ maybe-stopped-at)
(message "Computation paused.")
(haskell-debug/refresh))
(t
@@ -146,58 +252,103 @@
(message "Computation finished.")
(when (y-or-n-p "Computation completed without breaking. Reload the module and retry?")
(message "Reloading and resetting breakpoints...")
- (haskell-interactive-mode-reset-error (haskell-session))
+ (haskell-interactive-mode-reset-error (haskell-debug-session))
(cl-loop for break in breakpoints
- do (haskell-process-file-loadish
- (concat "load " (plist-get break :path))
- nil
- nil))
+ do (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ (concat ":load " (plist-get break :path))))
(cl-loop for break in breakpoints
do (haskell-debug-break break))
(haskell-debug/step expr)))))))))
(haskell-debug/refresh)))
-(defun haskell-debug/start-step (expr)
- "Start stepping EXPR."
- (interactive (list (read-from-minibuffer "Expression to step through: ")))
- (haskell-debug/step expr))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal functions
-(defun haskell-debug/refresh ()
- "Refresh the debugger buffer."
- (interactive)
- (with-current-buffer (haskell-debug-buffer-name (haskell-session))
- (let ((inhibit-read-only t)
- (p (point)))
- (erase-buffer)
- (insert (propertize (concat "Debugging "
- (haskell-session-name (haskell-session))
- "\n\n")
- 'face `((:weight bold))))
- (let ((modules (haskell-debug-get-modules))
- (breakpoints (haskell-debug-get-breakpoints))
- (context (haskell-debug-get-context))
- (history (haskell-debug-get-history)))
- (unless modules
- (insert (propertize "You have to load a module to start debugging."
- 'face
- 'haskell-debug-warning-face)
- "\n\n"))
- (haskell-debug-insert-bindings modules breakpoints context)
- (when modules
- (haskell-debug-insert-current-context context history)
- (haskell-debug-insert-breakpoints breakpoints))
- (haskell-debug-insert-modules modules))
- (insert "\n")
- (goto-char (min (point-max) p)))))
+(defun haskell-debug-session ()
+ "Get the Haskell session."
+ (or (haskell-session-maybe)
+ (error "No Haskell session associated with this debug
+ buffer. Please just close the buffer and start again.")))
-(defun haskell-debug-break (break)
- "Set BREAK breakpoint in module at line/col."
- (haskell-process-queue-without-filters
- (haskell-process)
- (format ":break %s %s %d"
- (plist-get break :module)
- (plist-get (plist-get break :span) :start-line)
- (plist-get (plist-get break :span) :start-col))))
+(defun haskell-debug-process ()
+ "Get the Haskell session."
+ (or (haskell-session-process (haskell-session-maybe))
+ (error "No Haskell session associated with this debug
+ buffer. Please just close the buffer and start again.")))
+
+(defun haskell-debug-buffer-name (session)
+ "The debug buffer name for the current session."
+ (format "*debug:%s*"
+ (haskell-session-name session)))
+
+(defun haskell-debug-get-breakpoints ()
+ "Get the list of breakpoints currently set."
+ (let ((string (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ ":show breaks")))
+ (if (string= string "No active breakpoints.\n")
+ (list)
+ (mapcar #'haskell-debug-parse-break-point
+ (haskell-debug-split-string string)))))
+
+(defun haskell-debug-get-modules ()
+ "Get the list of modules currently set."
+ (let ((string (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ ":show modules")))
+ (if (string= string "")
+ (list)
+ (mapcar #'haskell-debug-parse-module
+ (haskell-debug-split-string string)))))
+
+(defun haskell-debug-get-context ()
+ "Get the current context."
+ (let ((string (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ ":show context")))
+ (if (string= string "")
+ nil
+ (haskell-debug-parse-context string))))
+
+(defun haskell-debug-get-history ()
+ "Get the step history."
+ (let ((string (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ ":history")))
+ (if (or (string= string "")
+ (string= string "Not stopped at a breakpoint\n"))
+ nil
+ (if (string= string "Empty history. Perhaps you forgot to use :trace?\n")
+ nil
+ (let ((entries (mapcar #'haskell-debug-parse-history-entry
+ (cl-remove-if (lambda (line) (or (string= "" line)
+ (string= "..." line)))
+ (haskell-debug-split-string string)))))
+ (setq haskell-debug-history-cache
+ entries)
+ entries)))))
+
+(defun haskell-debug-insert-bindings (modules breakpoints context)
+ "Insert a list of bindings."
+ (if breakpoints
+ (progn (haskell-debug-insert-binding "s" "step into an expression")
+ (haskell-debug-insert-binding "b" "breakpoint" t))
+ (progn
+ (when modules
+ (haskell-debug-insert-binding "b" "breakpoint"))
+ (when breakpoints
+ (haskell-debug-insert-binding "s" "step into an expression" t))))
+ (when breakpoints
+ (haskell-debug-insert-binding "d" "delete breakpoint"))
+ (when context
+ (haskell-debug-insert-binding "a" "abandon context")
+ (haskell-debug-insert-binding "c" "continue" t))
+ (when context
+ (haskell-debug-insert-binding "p" "previous step")
+ (haskell-debug-insert-binding "n" "next step" t))
+ (haskell-debug-insert-binding "g" "refresh" t)
+ (insert "\n"))
(defun haskell-debug-insert-current-context (context history)
"Insert the current context."
@@ -207,28 +358,83 @@
(haskell-debug-insert-debug-finished))
(insert "\n"))
-(defun haskell-debug-insert-debug-finished ()
- "Insert message that no debugging is happening, but if there is
-some old history, then display that."
- (if haskell-debug-history-cache
- (progn (haskell-debug-insert-muted "Finished debugging.")
- (insert "\n")
- (haskell-debug-insert-history haskell-debug-history-cache))
- (haskell-debug-insert-muted "Not debugging right now.")))
-
-(defun haskell-debug-insert-context (context history)
- "Insert the context and history."
- (when context
- (insert (propertize (plist-get context :name) 'face `((:weight bold)))
- (haskell-debug-muted " - ")
- (file-name-nondirectory (plist-get context :path))
- (haskell-debug-muted " (stopped)")
- "\n"))
- (when haskell-debug-bindings-cache
- (insert "\n")
- (let ((bindings haskell-debug-bindings-cache))
- (insert
- (haskell-debug-get-span-string
+(defun haskell-debug-insert-breakpoints (breakpoints)
+ "insert the list of breakpoints."
+ (haskell-debug-insert-header "breakpoints")
+ (if (null breakpoints)
+ (haskell-debug-insert-muted "no active breakpoints.")
+ (cl-loop for break in breakpoints
+ do (insert (propertize (format "%d"
+ (plist-get break :number))
+ 'face `((:weight bold))
+ 'break break)
+ (haskell-debug-muted " - ")
+ (propertize (plist-get break :module)
+ 'break break
+ 'break break)
+ (haskell-debug-muted
+ (format " (%d:%d)"
+ (plist-get (plist-get break :span) :start-line)
+ (plist-get (plist-get break :span) :start-col)))
+ "\n")))
+ (insert "\n"))
+
+(defun haskell-debug-insert-modules (modules)
+ "Insert the list of modules."
+ (haskell-debug-insert-header "Modules")
+ (if (null modules)
+ (haskell-debug-insert-muted "No loaded modules.")
+ (progn (cl-loop for module in modules
+ do (insert (propertize (plist-get module :module)
+ 'module module
+ 'face `((:weight bold)))
+ (haskell-debug-muted " - ")
+ (propertize (file-name-nondirectory (plist-get module :path))
+ 'module module))
+ do (insert "\n")))))
+
+(defun haskell-debug-split-string (string)
+ "Split GHCi's line-based output, stripping the trailing newline."
+ (split-string string "\n" t))
+
+(defun haskell-debug-parse-context (string)
+ "Parse the context."
+ (cond
+ ((string-match "^--> \\(.+\\)\n \\(.+\\)" string)
+ (let ((name (match-string 1 string))
+ (stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
+ (list :name name
+ :path (plist-get stopped :path)
+ :span (plist-get stopped :span))))))
+
+(defun haskell-debug-insert-binding (binding desc &optional end)
+ "Insert a helpful keybinding."
+ (insert (propertize binding 'face 'haskell-debug-keybinding-face)
+ (haskell-debug-muted " - ")
+ desc
+ (if end
+ "\n"
+ (haskell-debug-muted ", "))))
+
+(defun haskell-debug-insert-header (title)
+ "Insert a header title."
+ (insert (propertize title
+ 'face 'haskell-debug-heading-face)
+ "\n\n"))
+
+(defun haskell-debug-insert-context (context history)
+ "Insert the context and history."
+ (when context
+ (insert (propertize (plist-get context :name) 'face `((:weight bold)))
+ (haskell-debug-muted " - ")
+ (file-name-nondirectory (plist-get context :path))
+ (haskell-debug-muted " (stopped)")
+ "\n"))
+ (when haskell-debug-bindings-cache
+ (insert "\n")
+ (let ((bindings haskell-debug-bindings-cache))
+ (insert
+ (haskell-debug-get-span-string
(plist-get bindings :path)
(plist-get bindings :span)))
(insert "\n\n")
@@ -241,6 +447,86 @@ some old history, then display that."
(insert "\n")
(haskell-debug-insert-history history))))
+(defun haskell-debug-insert-debug-finished ()
+ "Insert message that no debugging is happening, but if there is
+some old history, then display that."
+ (if haskell-debug-history-cache
+ (progn (haskell-debug-insert-muted "Finished debugging.")
+ (insert "\n")
+ (haskell-debug-insert-history haskell-debug-history-cache))
+ (haskell-debug-insert-muted "Not debugging right now.")))
+
+(defun haskell-debug-insert-muted (text)
+ "Insert some muted text."
+ (insert (haskell-debug-muted text)
+ "\n"))
+
+(defun haskell-debug-muted (text)
+ "Make some muted text."
+ (propertize text 'face 'haskell-debug-muted-face))
+
+(defun haskell-debug-parse-logged (string)
+ "Parse the logged breakpoint."
+ (cond
+ ((string= "no more logged breakpoints\n" string)
+ nil)
+ ((string= "already at the beginning of the history\n" string)
+ nil)
+ (t
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (list :path (progn (search-forward " at ")
+ (buffer-substring-no-properties
+ (point)
+ (1- (search-forward ":"))))
+ :span (haskell-debug-parse-span
+ (buffer-substring-no-properties
+ (point)
+ (line-end-position)))
+ :types (progn (forward-line)
+ (haskell-debug-split-string
+ (buffer-substring-no-properties
+ (point)
+ (point-max)))))))))
+
+(defun haskell-debug-parse-stopped-at (string)
+ "Parse the location stopped at from the given string.
+
+For example:
+
+Stopped at /home/foo/project/src/x.hs:6:25-36
+
+"
+ (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
+ string)))
+ (when index
+ (list :path (match-string 1 string)
+ :span (haskell-debug-parse-span (match-string 2 string))
+ :types (cdr (haskell-debug-split-string (substring string index)))))))
+
+(defun haskell-debug-get-span-string (path span)
+ "Get the string from the PATH and the SPAN."
+ (save-window-excursion
+ (find-file path)
+ (buffer-substring
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (plist-get span :start-line)))
+ (forward-char (1- (plist-get span :start-col)))
+ (point))
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (plist-get span :end-line)))
+ (forward-char (plist-get span :end-col))
+ (point)))))
+
+(defun haskell-debug-make-fake-history (context)
+ "Make a fake history item."
+ (list :index -1
+ :path (plist-get context :path)
+ :span (plist-get context :span)))
+
(defun haskell-debug-insert-history (history)
"Insert tracing HISTORY."
(let ((i (length history)))
@@ -259,11 +545,38 @@ some old history, then display that."
"\n")
(setq i (1- i))))))
-(defun haskell-debug-make-fake-history (context)
- "Make a fake history item."
- (list :index -1
- :path (plist-get context :path)
- :span (plist-get context :span)))
+(defun haskell-debug-parse-span (string)
+ "Parse a source span from a string.
+
+Examples:
+
+ (5,1)-(6,37)
+ 6:25-36
+ 5:20
+
+People like to make other people's lives interesting by making
+variances in source span notation."
+ (cond
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
+ string)
+ (list :start-line (string-to-number (match-string 1 string))
+ :start-col (string-to-number (match-string 2 string))
+ :end-line (string-to-number (match-string 1 string))
+ :end-col (string-to-number (match-string 3 string))))
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)"
+ string)
+ (list :start-line (string-to-number (match-string 1 string))
+ :start-col (string-to-number (match-string 2 string))
+ :end-line (string-to-number (match-string 1 string))
+ :end-col (string-to-number (match-string 2 string))))
+ ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
+ string)
+ (list :start-line (string-to-number (match-string 1 string))
+ :start-col (string-to-number (match-string 2 string))
+ :end-line (string-to-number (match-string 3 string))
+ :end-col (string-to-number (match-string 4 string))))
+ (t (error "Unable to parse source span from string: %s"
+ string))))
(defun haskell-debug-preview-span (span string &optional collapsed)
"Make a one-line preview of the given expression."
@@ -290,121 +603,45 @@ some old history, then display that."
(point-max)))
(buffer-string))))
-(defun haskell-debug-get-span-string (path span)
- "Get the string from the PATH and the SPAN."
- (save-window-excursion
- (find-file path)
- (buffer-substring
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (plist-get span :start-line)))
- (forward-char (1- (plist-get span :start-col)))
- (point))
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (plist-get span :end-line)))
- (forward-char (plist-get span :end-col))
- (point)))))
-
-(defun haskell-debug-insert-bindings (modules breakpoints context)
- "Insert a list of bindings."
- (if breakpoints
- (progn (haskell-debug-insert-binding "s" "step into an expression")
- (haskell-debug-insert-binding "b" "breakpoint" t))
- (progn
- (when modules
- (haskell-debug-insert-binding "b" "breakpoint"))
- (when breakpoints
- (haskell-debug-insert-binding "s" "step into an expression" t))))
- (when breakpoints
- (haskell-debug-insert-binding "d" "delete breakpoint"))
- (when context
- (haskell-debug-insert-binding "a" "abandon context")
- (haskell-debug-insert-binding "c" "continue" t))
- (when context
- (haskell-debug-insert-binding "p" "previous step")
- (haskell-debug-insert-binding "n" "next step" t))
- (haskell-debug-insert-binding "g" "refresh" t)
- (insert "\n"))
-
-(defun haskell-debug-insert-binding (binding desc &optional end)
- "Insert a helpful keybinding."
- (insert (propertize binding 'face 'haskell-debug-keybinding-face)
- (haskell-debug-muted " - ")
- desc
- (if end
- "\n"
- (haskell-debug-muted ", "))))
-
-(defun haskell-debug/breakpoint-numbers ()
- "List breakpoint numbers."
- (interactive)
- (let ((breakpoints (mapcar (lambda (breakpoint)
- (number-to-string (plist-get breakpoint :number)))
- (haskell-debug-get-breakpoints))))
- (if (null breakpoints)
- (message "No breakpoints.")
- (message "Breakpoint(s): %s"
- (mapconcat #'identity
- breakpoints
- ", ")))))
-
-(defun haskell-debug/abandon ()
- "Abandon the current computation."
- (interactive)
- (haskell-debug-with-breakpoints
- (haskell-process-queue-sync-request (haskell-process) ":abandon")
- (message "Computation abandoned.")
- (setq haskell-debug-history-cache nil)
- (setq haskell-debug-bindings-cache nil)
- (haskell-debug/refresh)))
-
-(defun haskell-debug/continue ()
- "Continue the current computation."
- (interactive)
- (haskell-debug-with-breakpoints
- (haskell-process-queue-sync-request (haskell-process) ":continue")
- (message "Computation continued.")
- (setq haskell-debug-history-cache nil)
- (setq haskell-debug-bindings-cache nil)
- (haskell-debug/refresh)))
+(defun haskell-debug-start (session)
+ "Start the debug mode."
+ (setq buffer-read-only t)
+ (haskell-session-assign session)
+ (haskell-debug/refresh))
-(defun haskell-debug/break-on-function ()
- "Break on function IDENT."
+(defun haskell-debug ()
+ "Start the debugger for the current Haskell (GHCi) session."
(interactive)
- (haskell-debug-with-modules
- (let ((ident (read-from-minibuffer "Function: "
- (haskell-ident-at-point))))
- (haskell-process-queue-sync-request
- (haskell-process)
- (concat ":break "
- ident))
- (message "Breaking on function: %s" ident)
- (haskell-debug/refresh))))
+ (let ((session (haskell-debug-session)))
+ (switch-to-buffer-other-window (haskell-debug-buffer-name session))
+ (unless (eq major-mode 'haskell-debug-mode)
+ (haskell-debug-mode)
+ (haskell-debug-start session))))
-(defun haskell-debug/select ()
- "Select whatever is at point."
- (interactive)
- (cond
- ((get-text-property (point) 'break)
- (let ((break (get-text-property (point) 'break)))
- (haskell-debug-highlight (plist-get break :path)
- (plist-get break :span))))
- ((get-text-property (point) 'module)
- (let ((break (get-text-property (point) 'module)))
- (haskell-debug-highlight (plist-get break :path))))))
+(defun haskell-debug-break (break)
+ "Set BREAK breakpoint in module at line/col."
+ (haskell-process-queue-without-filters
+ (haskell-debug-process)
+ (format ":break %s %s %d"
+ (plist-get break :module)
+ (plist-get (plist-get break :span) :start-line)
+ (plist-get (plist-get break :span) :start-col))))
-(defun haskell-debug/next ()
- "Go to next step to inspect bindings."
- (interactive)
- (haskell-debug-with-breakpoints
- (haskell-debug-navigate "forward")))
+(defun haskell-debug-navigate (direction)
+ "Navigate in DIRECTION \"back\" or \"forward\"."
+ (let ((string (haskell-process-queue-sync-request
+ (haskell-debug-process)
+ (concat ":" direction))))
+ (let ((bindings (haskell-debug-parse-logged string)))
+ (setq haskell-debug-bindings-cache
+ bindings)
+ (when (not bindings)
+ (message "No more %s results!" direction)))
+ (haskell-debug/refresh)))
-(defun haskell-debug/previous ()
- "Go to previous step to inspect the bindings."
- (interactive)
- (haskell-debug-with-breakpoints
- (haskell-debug-navigate "back")))
+(defun haskell-debug-session-debugging-p (session)
+ "Does the session have a debugging buffer open?"
+ (not (not (get-buffer (haskell-debug-buffer-name session)))))
(defun haskell-debug-highlight (path &optional span)
"Highlight the file at span."
@@ -438,145 +675,6 @@ some old history, then display that."
(delete-overlay o))
(delete-overlay p)))))
-(defun haskell-debug-insert-modules (modules)
- "Insert the list of modules."
- (haskell-debug-insert-header "Modules")
- (if (null modules)
- (haskell-debug-insert-muted "No loaded modules.")
- (progn (cl-loop for module in modules
- do (insert (propertize (plist-get module :module)
- 'module module
- 'face `((:weight bold)))
- (haskell-debug-muted " - ")
- (propertize (file-name-nondirectory (plist-get module :path))
- 'module module))
- do (insert "\n")))))
-
-(defun haskell-debug-insert-header (title)
- "Insert a header title."
- (insert (propertize title
- 'face 'haskell-debug-heading-face)
- "\n\n"))
-
-(defun haskell-debug-insert-breakpoints (breakpoints)
- "Insert the list of breakpoints."
- (haskell-debug-insert-header "Breakpoints")
- (if (null breakpoints)
- (haskell-debug-insert-muted "No active breakpoints.")
- (cl-loop for break in breakpoints
- do (insert (propertize (format "%d"
- (plist-get break :number))
- 'face `((:weight bold))
- 'break break)
- (haskell-debug-muted " - ")
- (propertize (plist-get break :module)
- 'break break
- 'break break)
- (haskell-debug-muted
- (format " (%d:%d)"
- (plist-get (plist-get break :span) :start-line)
- (plist-get (plist-get break :span) :start-col)))
- "\n")))
- (insert "\n"))
-
-(defun haskell-debug-insert-muted (text)
- "Insert some muted text."
- (insert (haskell-debug-muted text)
- "\n"))
-
-(defun haskell-debug-muted (text)
- "Make some muted text."
- (propertize text 'face 'haskell-debug-muted-face))
-
-(defun haskell-debug-buffer-name (session)
- "The debug buffer name for the current session."
- (format "*debug:%s*"
- (haskell-session-name session)))
-
-(defun haskell-debug-start (session)
- "Start the debug mode."
- (setq buffer-read-only t)
- (haskell-session-assign session)
- (haskell-debug/refresh))
-
-(defun haskell-debug-split-string (string)
- "Split GHCi's line-based output, stripping the trailing newline."
- (split-string string "\n" t))
-
-(defun haskell-debug-get-modules ()
- "Get the list of modules currently set."
- (let ((string (haskell-process-queue-sync-request
- (haskell-process)
- ":show modules")))
- (if (string= string "")
- (list)
- (mapcar #'haskell-debug-parse-module
- (haskell-debug-split-string string)))))
-
-(defun haskell-debug-get-context ()
- "Get the current context."
- (let ((string (haskell-process-queue-sync-request
- (haskell-process)
- ":show context")))
- (if (string= string "")
- nil
- (haskell-debug-parse-context string))))
-
-(defun haskell-debug-navigate (direction)
- "Navigate in DIRECTION \"back\" or \"forward\"."
- (let ((string (haskell-process-queue-sync-request
- (haskell-process)
- (concat ":" direction))))
- (let ((bindings (haskell-debug-parse-logged string)))
- (set (make-local-variable 'haskell-debug-bindings-cache)
- bindings)
- (when (not bindings)
- (message "No more %s results!" direction)))
- (haskell-debug/refresh)))
-
-(defun haskell-debug-parse-logged (string)
- "Parse the logged breakpoint."
- (cond
- ((string= "no more logged breakpoints\n" string)
- nil)
- ((string= "already at the beginning of the history\n" string)
- nil)
- (t
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (list :path (progn (search-forward " at ")
- (buffer-substring-no-properties
- (point)
- (1- (search-forward ":"))))
- :span (haskell-debug-parse-span
- (buffer-substring-no-properties
- (point)
- (line-end-position)))
- :types (progn (forward-line)
- (haskell-debug-split-string
- (buffer-substring-no-properties
- (point)
- (point-max)))))))))
-
-(defun haskell-debug-get-history ()
- "Get the step history."
- (let ((string (haskell-process-queue-sync-request
- (haskell-process)
- ":history")))
- (if (or (string= string "")
- (string= string "Not stopped at a breakpoint\n"))
- nil
- (if (string= string "Empty history. Perhaps you forgot to use :trace?\n")
- nil
- (let ((entries (mapcar #'haskell-debug-parse-history-entry
- (cl-remove-if (lambda (line) (or (string= "" line)
- (string= "..." line)))
- (haskell-debug-split-string string)))))
- (set (make-local-variable 'haskell-debug-history-cache)
- entries)
- entries)))))
-
(defun haskell-debug-parse-history-entry (string)
"Parse a history entry."
(if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$"
@@ -587,41 +685,6 @@ some old history, then display that."
:span (haskell-debug-parse-span (match-string 4 string)))
(error "Unable to parse history entry: %s" string)))
-(defun haskell-debug-parse-context (string)
- "Parse the context."
- (cond
- ((string-match "^--> \\(.+\\)\n \\(.+\\)" string)
- (let ((name (match-string 1 string))
- (stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
- (list :name name
- :path (plist-get stopped :path)
- :span (plist-get stopped :span))))))
-
-(defun haskell-debug-get-breakpoints ()
- "Get the list of breakpoints currently set."
- (let ((string (haskell-process-queue-sync-request
- (haskell-process)
- ":show breaks")))
- (if (string= string "No active breakpoints.\n")
- (list)
- (mapcar #'haskell-debug-parse-break-point
- (haskell-debug-split-string string)))))
-
-(defun haskell-debug-parse-stopped-at (string)
- "Parse the location stopped at from the given string.
-
-For example:
-
-Stopped at /home/foo/project/src/x.hs:6:25-36
-
-"
- (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
- string)))
- (when index
- (list :path (match-string 1 string)
- :span (haskell-debug-parse-span (match-string 2 string))
- :types (cdr (haskell-debug-split-string (substring string index)))))))
-
(defun haskell-debug-parse-module (string)
"Parse a module and path.
@@ -654,38 +717,6 @@ For example:
(error "Unable to parse breakpoint from string: %s"
string)))
-(defun haskell-debug-parse-span (string)
- "Parse a source span from a string.
-
-Examples:
-
- (5,1)-(6,37)
- 6:25-36
- 5:20
-
-People like to make other people's lives interesting by making
-variances in source span notation."
- (cond
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
- string)
- (list :start-line (string-to-number (match-string 1 string))
- :start-col (string-to-number (match-string 2 string))
- :end-line (string-to-number (match-string 1 string))
- :end-col (string-to-number (match-string 3 string))))
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)"
- string)
- (list :start-line (string-to-number (match-string 1 string))
- :start-col (string-to-number (match-string 2 string))
- :end-line (string-to-number (match-string 1 string))
- :end-col (string-to-number (match-string 2 string))))
- ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
- string)
- (list :start-line (string-to-number (match-string 1 string))
- :start-col (string-to-number (match-string 2 string))
- :end-line (string-to-number (match-string 3 string))
- :end-col (string-to-number (match-string 4 string))))
- (t (error "Unable to parse source span from string: %s"
- string))))
-
(provide 'haskell-debug)
+
;;; haskell-debug.el ends here
diff --git a/haskell-font-lock.el b/haskell-font-lock.el
index c4afaf7d8..c6ce110bb 100644
--- a/haskell-font-lock.el
+++ b/haskell-font-lock.el
@@ -693,6 +693,16 @@ Invokes `haskell-font-lock-hook' if not nil."
"Turns off font locking in current buffer."
(font-lock-mode -1))
+(defun haskell-fontify-as-mode (text mode)
+ "Fontify TEXT as MODE, returning the fontified text."
+ (with-temp-buffer
+ (funcall mode)
+ (insert text)
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (with-no-warnings (font-lock-fontify-buffer)))
+ (buffer-substring (point-min) (point-max))))
+
;; Provide ourselves:
(provide 'haskell-font-lock)
diff --git a/haskell-interactive-mode.el b/haskell-interactive-mode.el
index fff690665..6e9225fac 100644
--- a/haskell-interactive-mode.el
+++ b/haskell-interactive-mode.el
@@ -27,46 +27,32 @@
;;; Code:
-(require 'ansi-color)
-(require 'cl-lib)
+(require 'haskell-compile)
+(require 'haskell-navigate-imports)
(require 'haskell-process)
(require 'haskell-collapse)
(require 'haskell-session)
(require 'haskell-show)
+(require 'haskell-font-lock)
+(require 'haskell-presentation-mode)
-(defcustom haskell-interactive-mode-scroll-to-bottom
- nil
- "Scroll to bottom in the REPL always."
- :type 'boolean
- :group 'haskell-interactive)
+(require 'ansi-color)
+(require 'cl-lib)
+(require 'etags)
-(defcustom haskell-interactive-popup-errors
- t
- "Popup errors in a separate buffer."
- :type 'boolean
- :group 'haskell-interactive)
+(defvar haskell-interactive-mode-history-index)
+(make-variable-buffer-local 'haskell-interactive-mode-history-index)
-(defcustom haskell-interactive-mode-collapse
- nil
- "Collapse printed results."
- :type 'boolean
- :group 'haskell-interactive)
+(defvar haskell-interactive-mode-history (list))
+(make-variable-buffer-local 'haskell-interactive-mode-history)
-(defcustom haskell-interactive-types-for-show-ambiguous
- t
- "Show types when there's no Show instance or there's an
-ambiguous class constraint."
- :type 'boolean
- :group 'haskell-interactive)
+(defvar haskell-interactive-mode-completion-cache)
+(make-variable-buffer-local 'haskell-interactive-mode-completion-cache)
-(defcustom haskell-interactive-mode-eval-pretty
+(defvar haskell-interactive-mode-old-prompt-start
nil
- "Print eval results that can be parsed as Show instances prettily. Requires sexp-show (on Hackage)."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defvar haskell-interactive-prompt "λ> "
- "The prompt to use.")
+ "Mark used for the old beginning of the prompt.")
+(make-variable-buffer-local 'haskell-interactive-mode-old-prompt-start)
(defun haskell-interactive-prompt-regex ()
"Generate a regex for searching for any occurence of the prompt
@@ -74,43 +60,8 @@ at the beginning of the line. This should prevent any
interference with prompts that look like haskell expressions."
(concat "^" (regexp-quote haskell-interactive-prompt)))
-(defvar haskell-interactive-mode-prompt-start
- nil
- "Mark used for the beginning of the prompt.")
-
-(defvar haskell-interactive-mode-result-end
- nil
- "Mark used to figure out where the end of the current result
- output is. Used to distinguish betwen user input.")
-
-(defvar haskell-interactive-mode-old-prompt-start
- nil
- "Mark used for the old beginning of the prompt.")
-
-(defcustom haskell-interactive-mode-eval-mode
- nil
- "Use the given mode's font-locking to render some text."
- :type '(choice function (const :tag "None" nil))
- :group 'haskell-interactive)
-
-(defcustom haskell-interactive-mode-hide-multi-line-errors
- nil
- "Hide collapsible multi-line compile messages by default."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-interactive-mode-delete-superseded-errors
- t
- "Whether to delete compile messages superseded by recompile/reloads."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-interactive-mode-include-file-name
- t
- "Include the file name of the module being compiled when
-printing compilation messages."
- :type 'boolean
- :group 'haskell-interactive)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Globals used internally
(defvar haskell-interactive-mode-map
(let ((map (make-sparse-keymap)))
@@ -132,12 +83,6 @@ printing compilation messages."
map)
"Interactive Haskell mode map.")
-;; buffer-local variables used internally by `haskell-interactive-mode'
-(defvar haskell-interactive-mode-history)
-(defvar haskell-interactive-mode-history-index)
-(defvar haskell-interactive-mode-completion-cache)
-
-;;;###autoload
(define-derived-mode haskell-interactive-mode fundamental-mode "Interactive-Haskell"
"Interactive mode for Haskell.
@@ -147,9 +92,9 @@ information.
Key bindings:
\\{haskell-interactive-mode-map}"
:group 'haskell-interactive
- (set (make-local-variable 'haskell-interactive-mode-history) (list))
- (set (make-local-variable 'haskell-interactive-mode-history-index) 0)
- (set (make-local-variable 'haskell-interactive-mode-completion-cache) nil)
+ (setq haskell-interactive-mode-history (list))
+ (setq haskell-interactive-mode-history-index 0)
+ (setq haskell-interactive-mode-completion-cache nil)
(setq next-error-function 'haskell-interactive-next-error-function)
(add-hook 'completion-at-point-functions
@@ -157,6 +102,33 @@ Key bindings:
(haskell-interactive-mode-prompt))
+(defvar haskell-interactive-mode-prompt-start
+ nil
+ "Mark used for the beginning of the prompt.")
+
+(defvar haskell-interactive-mode-result-end
+ nil
+ "Mark used to figure out where the end of the current result
+ output is. Used to distinguish betwen user input.")
+
+(defvar haskell-interactive-previous-buffer nil
+ "Records the buffer to which `haskell-interactive-switch-back' should jump.
+This is set by `haskell-interactive-switch', and should otherwise
+be nil.")
+(make-variable-buffer-local 'haskell-interactive-previous-buffer)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Hooks
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mode
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Faces
+
(defface haskell-interactive-face-prompt
'((t :inherit font-lock-function-name-face))
"Face for the prompt."
@@ -182,6 +154,9 @@ Key bindings:
"Face for trailing garbage after a command has completed."
:group 'haskell-interactive)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Actions
+
(defun haskell-interactive-mode-newline-indent ()
"Make newline and indent."
(interactive)
@@ -194,36 +169,6 @@ Key bindings:
(kill-region haskell-interactive-mode-prompt-start
(line-end-position)))
-;;;###autoload
-(defun haskell-interactive-bring ()
- "Bring up the interactive mode for this session."
- (interactive)
- (let* ((session (haskell-session))
- (buffer (haskell-session-interactive-buffer session)))
- (unless (and (cl-find-if (lambda (window) (equal (window-buffer window) buffer))
- (window-list))
- (= 2 (length (window-list))))
- (delete-other-windows)
- (display-buffer buffer)
- (other-window 1))))
-
-(defvar haskell-interactive-previous-buffer nil
- "Records the buffer to which `haskell-interactive-switch-back' should jump.
-This is set by `haskell-interactive-switch', and should otherwise
-be nil.")
-(make-variable-buffer-local 'haskell-interactive-previous-buffer)
-
-;;;###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-interactive-switch-back ()
"Switch back to the buffer from which this interactive buffer was reached."
(interactive)
@@ -231,15 +176,6 @@ be nil.")
(switch-to-buffer-other-window haskell-interactive-previous-buffer)
(message "No previous buffer.")))
-(defun haskell-interactive-mode-return ()
- "Handle the return key."
- (interactive)
- (cond
- ((haskell-interactive-at-compile-message)
- (next-error-internal))
- (t
- (haskell-interactive-handle-expr))))
-
(defun haskell-interactive-mode-space (n)
"Handle the space key."
(interactive "p")
@@ -257,156 +193,12 @@ be nil.")
haskell-interactive-mode-prompt-start
nil))
-(defun haskell-interactive-handle-expr ()
- "Handle an inputted expression at the REPL."
- (when (haskell-interactive-at-prompt)
- (let ((expr (haskell-interactive-mode-input)))
- (unless (string= "" (replace-regexp-in-string " " "" expr))
- (cond
- ;; If already evaluating, then the user is trying to send
- ;; input to the REPL during evaluation. Most likely in
- ;; response to a getLine-like function.
- ((and (haskell-process-evaluating-p (haskell-process))
- (= (line-end-position) (point-max)))
- (goto-char (point-max))
- (let ((process (haskell-process))
- (string (buffer-substring-no-properties
- haskell-interactive-mode-result-end
- (point))))
- (insert "\n")
- ;; Bring the marker forward
- (setq haskell-interactive-mode-result-end
- (point-max))
- (haskell-process-set-sent-stdin process t)
- (haskell-process-send-string process string)))
- ;; Otherwise we start a normal evaluation call.
- (t (setq haskell-interactive-mode-old-prompt-start
- (copy-marker haskell-interactive-mode-prompt-start))
- (set-marker haskell-interactive-mode-prompt-start (point-max))
- (haskell-interactive-mode-history-add expr)
- (haskell-interactive-mode-do-expr expr)))))))
-
-(defun haskell-interactive-mode-do-expr (expr)
- (cond
- ((string-match "^:present " expr)
- (haskell-interactive-mode-do-presentation (replace-regexp-in-string "^:present " "" expr)))
- (t
- (haskell-interactive-mode-run-expr expr))))
-
-(defun haskell-interactive-mode-run-expr (expr)
- "Run the given expression."
- (let ((session (haskell-session))
- (process (haskell-process))
- (lines (length (split-string expr "\n"))))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list session process expr 0)
- :go (lambda (state)
- (goto-char (point-max))
- (insert "\n")
- (setq haskell-interactive-mode-result-end
- (point-max))
- (haskell-process-send-string (cadr state)
- (haskell-interactive-mode-multi-line (cl-caddr state)))
- (haskell-process-set-evaluating (cadr state) t))
- :live (lambda (state buffer)
- (unless (and (string-prefix-p ":q" (cl-caddr state))
- (string-prefix-p (cl-caddr state) ":quit"))
- (let* ((cursor (cl-cadddr state))
- (next (replace-regexp-in-string
- haskell-process-prompt-regex
- ""
- (substring buffer cursor))))
- (haskell-interactive-mode-eval-result (car state) next)
- (setf (cl-cdddr state) (list (length buffer)))
- nil)))
- :complete
- (lambda (state response)
- (haskell-process-set-evaluating (cadr state) nil)
- (unless (haskell-interactive-mode-trigger-compile-error state response)
- (haskell-interactive-mode-expr-result state response)))))))
-
-(defun haskell-interactive-mode-trigger-compile-error (state response)
- "Look for an compile error; if there is one, pop
- that up in a buffer, similar to `debug-on-error'."
- (when (and haskell-interactive-types-for-show-ambiguous
- (string-match "^\n:[0-9]+:[0-9]+:" response)
- (not (string-match "^\n:[0-9]+:[0-9]+:[\n ]+Warning:" response)))
- (let ((inhibit-read-only t))
- (delete-region haskell-interactive-mode-prompt-start (point))
- (set-marker haskell-interactive-mode-prompt-start
- haskell-interactive-mode-old-prompt-start)
- (goto-char (point-max)))
- (cond
- ((and (not (haskell-interactive-mode-line-is-query (elt state 2)))
- (or (string-match "No instance for (?Show[ \n]" response)
- (string-match "Ambiguous type variable " response)))
- (haskell-process-reset (haskell-process))
- (let ((resp (haskell-process-queue-sync-request
- (haskell-process)
- (concat ":t "
- (buffer-substring-no-properties
- haskell-interactive-mode-prompt-start
- (point-max))))))
- (cond
- ((not (string-match ":" resp))
- (haskell-interactive-mode-insert-error resp))
- (t (haskell-interactive-popup-error response)))))
- (t (haskell-interactive-popup-error response)
- t))
- t))
-
-(defun haskell-interactive-popup-error (response)
- "Popup an error."
- (if haskell-interactive-popup-errors
- (let ((buf (get-buffer-create "*HS-Error*")))
- (pop-to-buffer buf nil t)
- (with-current-buffer buf
-
- (haskell-error-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (propertize response
- 'font-lock-face
- 'haskell-interactive-face-compile-error))
- (goto-char (point-min))
- (delete-blank-lines)
- (insert (propertize "-- Hit `q' to close this window.\n\n"
- 'font-lock-face 'font-lock-comment-face))
- (save-excursion
- (goto-char (point-max))
- (insert (propertize "\n-- To disable popups, customize `haskell-interactive-popup-errors'.\n\n"
- 'font-lock-face 'font-lock-comment-face))))))
- (haskell-interactive-mode-insert-error response)))
-
-(defun haskell-interactive-mode-insert-error (response)
- "Insert an error message."
- (insert "\n"
- (haskell-fontify-as-mode
- response
- 'haskell-mode))
- (haskell-interactive-mode-prompt))
-
(define-derived-mode haskell-error-mode
special-mode "Error"
"Major mode for viewing Haskell compile errors.")
;; (define-key haskell-error-mode-map (kbd "q") 'quit-window)
-(defun haskell-interactive-mode-expr-result (state response)
- "Print the result of evaluating the expression."
- (let ((response
- (with-temp-buffer
- (insert (haskell-interactive-mode-cleanup-response
- (cl-caddr state) response))
- (haskell-interactive-mode-handle-h (point-min))
- (buffer-string))))
- (when haskell-interactive-mode-eval-mode
- (unless (haskell-process-sent-stdin-p (cadr state))
- (haskell-interactive-mode-eval-as-mode (car state) response))))
- (haskell-interactive-mode-prompt (car state)))
-
(defun haskell-interactive-mode-handle-h (&optional bound)
"Handle ^H in output."
(let ((bound (point-min))
@@ -481,33 +273,6 @@ do the
(and (string-match "^:[itk] " line)
t))
-(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-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))))))
-
(defun haskell-interactive-mode-beginning ()
"Go to the start of the line."
(interactive)
@@ -515,22 +280,6 @@ do the
(goto-char haskell-interactive-mode-prompt-start)
(move-beginning-of-line nil)))
-(defun haskell-interactive-mode-clear ()
- "Clear the screen and put any current input into the history."
- (interactive)
- (let ((session (haskell-session)))
- (with-current-buffer (haskell-session-interactive-buffer session)
- (let ((inhibit-read-only t))
- (set-text-properties (point-min) (point-max) nil))
- (delete-region (point-min) (point-max))
- (remove-overlays)
- (haskell-interactive-mode-prompt session)
- (haskell-session-set session 'next-error-region nil)
- (haskell-session-set session 'next-error-locus nil))
- (with-current-buffer (get-buffer-create "*haskell-process-log*")
- (delete-region (point-min) (point-max))
- (remove-overlays))))
-
(defun haskell-interactive-mode-input-partial ()
"Get the interactive mode input up to point."
(let ((input-start (haskell-interactive-at-prompt)))
@@ -598,32 +347,6 @@ SESSION, otherwise operate on the current buffer.
(goto-char (point-max))
(set-window-point w (point-max)))))
-(defun haskell-interactive-mode-eval-as-mode (session text)
- "Insert TEXT font-locked according to `haskell-interactive-mode-eval-mode'."
- (with-current-buffer (haskell-session-interactive-buffer session)
- (let ((inhibit-read-only t))
- (delete-region (1+ haskell-interactive-mode-prompt-start) (point))
- (goto-char (point-max))
- (let ((start (point)))
- (insert (haskell-fontify-as-mode text
- haskell-interactive-mode-eval-mode))
- (when haskell-interactive-mode-collapse
- (haskell-collapse start (point)))))))
-
-;;;###autoload
-(defun haskell-interactive-mode-echo (session message &optional mode)
- "Echo a read only piece of text before the prompt."
- (with-current-buffer (haskell-session-interactive-buffer session)
- (save-excursion
- (haskell-interactive-mode-goto-end-point)
- (insert (if mode
- (haskell-fontify-as-mode
- (concat message "\n")
- mode)
- (propertize (concat message "\n")
- 'read-only t
- 'rear-nonsticky t))))))
-
(defun haskell-interactive-mode-compile-error (session message)
"Echo an error."
(haskell-interactive-mode-compile-message
@@ -660,25 +383,6 @@ SESSION, otherwise operate on the current buffer.
'read-only t
'rear-nonsticky t)))))))
-(defun haskell-interactive-mode-compile-splice (session message)
- "Echo a compiler splice."
- (with-current-buffer (haskell-session-interactive-buffer session)
- (setq next-error-last-buffer (current-buffer))
- (save-excursion
- (haskell-interactive-mode-goto-end-point)
- (insert (haskell-fontify-as-mode message 'haskell-mode)
- "\n"))))
-
-(defun haskell-interactive-mode-insert-garbage (session message)
- "Echo a read only piece of text before the prompt."
- (with-current-buffer (haskell-session-interactive-buffer session)
- (save-excursion
- (haskell-interactive-mode-goto-end-point)
- (insert (propertize message
- 'font-lock-face 'haskell-interactive-face-garbage
- 'read-only t
- 'rear-nonsticky t)))))
-
(defun haskell-interactive-mode-insert (session message)
"Echo a read only piece of text before the prompt."
(with-current-buffer (haskell-session-interactive-buffer session)
@@ -703,93 +407,28 @@ SESSION, otherwise operate on the current buffer.
(setq haskell-interactive-mode-history-index
0))
-(defun haskell-interactive-mode-history-toggle (n)
- "Toggle the history n items up or down."
- (unless (null haskell-interactive-mode-history)
- (setq haskell-interactive-mode-history-index
- (mod (+ haskell-interactive-mode-history-index n)
- (length haskell-interactive-mode-history)))
- (unless (zerop haskell-interactive-mode-history-index)
- (message "History item: %d" haskell-interactive-mode-history-index))
- (haskell-interactive-mode-set-prompt
- (nth haskell-interactive-mode-history-index
- haskell-interactive-mode-history))))
-
-(defun haskell-interactive-mode-history-previous (arg)
- "Cycle backwards through input history."
- (interactive "*p")
- (when (haskell-interactive-at-prompt)
- (if (not (zerop arg))
- (haskell-interactive-mode-history-toggle arg)
- (setq haskell-interactive-mode-history-index 0)
- (haskell-interactive-mode-history-toggle 1))))
-
-(defun haskell-interactive-mode-history-next (arg)
- "Cycle forward through input history."
- (interactive "*p")
- (when (haskell-interactive-at-prompt)
- (if (not (zerop arg))
- (haskell-interactive-mode-history-toggle (- arg))
- (setq haskell-interactive-mode-history-index 0)
- (haskell-interactive-mode-history-toggle -1))))
-
-(defun haskell-interactive-mode-set-prompt (p)
- "Set (and overwrite) the current prompt."
- (with-current-buffer (haskell-session-interactive-buffer (haskell-session))
- (goto-char haskell-interactive-mode-prompt-start)
- (delete-region (point) (point-max))
- (insert p)))
+(defun haskell-mode-message-line (str)
+ "Message only one line, multiple lines just disturbs the programmer."
+ (let ((lines (split-string str "\n" t)))
+ (when (and (car lines) (stringp (car lines)))
+ (message "%s"
+ (concat (car lines)
+ (if (and (cdr lines) (stringp (cadr lines)))
+ (format " [ %s .. ]" (haskell-string-take (haskell-trim (cadr lines)) 10))
+ ""))))))
-(defun haskell-interactive-buffer ()
- "Get the interactive buffer of the session."
- (haskell-session-interactive-buffer (haskell-session)))
-
-(defun haskell-interactive-show-load-message (session type module-name file-name echo th)
- "Show the '(Compiling|Loading) X' message."
- (let ((msg (concat
- (cl-ecase type
- ('compiling
- (if haskell-interactive-mode-include-file-name
- (format "Compiling: %s (%s)" module-name file-name)
- (format "Compiling: %s" module-name)))
- ('loading (format "Loading: %s" module-name))
- ('import-cycle (format "Module has an import cycle: %s" module-name)))
- (if th " [TH]" ""))))
- (haskell-mode-message-line msg)
- (when haskell-interactive-mode-delete-superseded-errors
- (haskell-interactive-mode-delete-compile-messages session file-name))
- (when echo
- (haskell-interactive-mode-echo session msg))))
-
-(defun haskell-interactive-mode-completion-at-point-function ()
- "Offer completions for partial expression between prompt and point"
- (when (haskell-interactive-at-prompt)
- (let* ((process (haskell-process))
- (session (haskell-session))
- (inp (haskell-interactive-mode-input-partial)))
- (if (string= inp (car-safe haskell-interactive-mode-completion-cache))
- (cdr haskell-interactive-mode-completion-cache)
- (let* ((resp2 (haskell-process-get-repl-completions process inp))
- (rlen (- (length inp) (length (car resp2))))
- (coll (append (if (string-prefix-p inp "import") '("import"))
- (if (string-prefix-p inp "let") '("let"))
- (cdr resp2)))
- (result (list (- (point) rlen) (point) coll)))
- (setq haskell-interactive-mode-completion-cache (cons inp result))
- result)))))
-
-(defun haskell-interactive-mode-tab ()
- "Do completion if at prompt or else try collapse/expand."
- (interactive)
- (cond
- ((haskell-interactive-at-prompt)
- (completion-at-point))
- ((get-text-property (point) 'collapsible)
- (let ((column (current-column)))
- (search-backward-regexp "^[^ ]")
- (haskell-interactive-mode-tab-expand)
- (goto-char (+ column (line-beginning-position)))))
- (t (haskell-interactive-mode-tab-expand))))
+(defun haskell-interactive-mode-tab ()
+ "Do completion if at prompt or else try collapse/expand."
+ (interactive)
+ (cond
+ ((haskell-interactive-at-prompt)
+ (completion-at-point))
+ ((get-text-property (point) 'collapsible)
+ (let ((column (current-column)))
+ (search-backward-regexp "^[^ ]")
+ (haskell-interactive-mode-tab-expand)
+ (goto-char (+ column (line-beginning-position)))))
+ (t (haskell-interactive-mode-tab-expand))))
(defun haskell-interactive-mode-tab-expand ()
"Expand the rest of the message."
@@ -828,10 +467,180 @@ SESSION, otherwise operate on the current buffer.
(progn (goto-char (point-max))
nil)))
+(defun haskell-interactive-mode-delete-compile-messages (session &optional file-name)
+ "Delete compile messages in REPL buffer.
+If FILE-NAME is non-nil, restrict to removing messages concerning
+FILE-NAME only."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward-regexp "^Compilation failed.$" nil t 1)
+ (let ((inhibit-read-only t))
+ (delete-region (line-beginning-position)
+ (1+ (line-end-position))))
+ (goto-char (point-min)))
+ (while (when (re-search-forward haskell-interactive-mode-error-regexp nil t)
+ (let ((msg-file-name (match-string-no-properties 1))
+ (msg-startpos (line-beginning-position)))
+ ;; skip over hanging continuation message lines
+ (while (progn (forward-line) (looking-at "^[ ]+")))
+
+ (when (or (not file-name) (string= file-name msg-file-name))
+ (let ((inhibit-read-only t))
+ (set-text-properties msg-startpos (point) nil))
+ (delete-region msg-startpos (point))
+ ))
+ t)))))
+
+;;;###autoload
+(defun haskell-interactive-mode-reset-error (session)
+ "Reset the error cursor position."
+ (interactive)
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (haskell-interactive-mode-goto-end-point)
+ (let ((mrk (point-marker)))
+ (haskell-session-set session 'next-error-locus nil)
+ (haskell-session-set session 'next-error-region (cons mrk (copy-marker mrk t))))
+ (goto-char (point-max))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Misc
+
+(defun haskell-session-interactive-buffer (s)
+ "Get the session interactive buffer."
+ (let ((buffer (haskell-session-get s 'interactive-buffer)))
+ (if (and buffer (buffer-live-p buffer))
+ buffer
+ (let ((buffer (get-buffer-create (format "*%s*" (haskell-session-name s)))))
+ (haskell-session-set-interactive-buffer s buffer)
+ (with-current-buffer buffer
+ (haskell-interactive-mode)
+ (haskell-session-assign s))
+ (switch-to-buffer-other-window buffer)
+ buffer))))
+
+(defun haskell-process-cabal-live (state buffer)
+ "Do live updates for Cabal processes."
+ (haskell-interactive-mode-insert
+ (haskell-process-session (cadr state))
+ (replace-regexp-in-string
+ haskell-process-prompt-regex
+ ""
+ (substring buffer (cl-cadddr state))))
+ (setf (cl-cdddr state) (list (length buffer)))
+ nil)
+
+(defun haskell-process-parse-error (string)
+ "Parse the line number from the error."
+ (let ((span nil))
+ (cl-loop for regex
+ in haskell-compilation-error-regexp-alist
+ do (when (string-match (car regex) string)
+ (setq span
+ (list :file (match-string 1 string)
+ :line (string-to-number (match-string 2 string))
+ :col (string-to-number (match-string 4 string))
+ :line2 (when (match-string 3 string)
+ (string-to-number (match-string 3 string)))
+ :col2 (when (match-string 5 string)
+ (string-to-number (match-string 5 string)))))))
+ span))
+
+(defun haskell-process-suggest-add-package (session msg)
+ "Add the (matched) module to your cabal file."
+ (let* ((suggested-package (match-string 1 msg))
+ (package-name (replace-regexp-in-string "-[^-]+$" "" suggested-package))
+ (version (progn (string-match "\\([^-]+\\)$" suggested-package)
+ (match-string 1 suggested-package)))
+ (cabal-file (concat (haskell-session-name session)
+ ".cabal")))
+ (when (y-or-n-p
+ (format "Add `%s' to %s?"
+ package-name
+ cabal-file))
+ (haskell-cabal-add-dependency package-name version nil t))))
+
+(defun haskell-process-suggest-remove-import (session file import line)
+ "Suggest removing or commenting out IMPORT on LINE."
+ (let ((continue t)
+ (first t))
+ (cl-case (read-event
+ (propertize (format "%sThe import line `%s' is redundant. Remove? (y, n, c: comment out) "
+ (if (not first)
+ "Please answer n, y or c: "
+ "")
+ import)
+ 'face 'minibuffer-prompt))
+ (?y
+ (haskell-process-find-file session file)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (goto-char (line-beginning-position))
+ (delete-region (line-beginning-position)
+ (line-end-position))))
+ (?n
+ (message "Ignoring redundant import %s" import))
+ (?c
+ (haskell-process-find-file session file)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (goto-char (line-beginning-position))
+ (insert "-- "))))))
+
+(defun haskell-process-find-file (session file)
+ "Find the given file in the project."
+ (find-file (cond ((file-exists-p (concat (haskell-session-current-dir session) "/" file))
+ (concat (haskell-session-current-dir session) "/" file))
+ ((file-exists-p (concat (haskell-session-cabal-dir session) "/" file))
+ (concat (haskell-session-cabal-dir session) "/" file))
+ (t file))))
+
+(defun haskell-process-suggest-pragma (session pragma extension file)
+ "Suggest to add something to the top of the file."
+ (let ((string (format "{-# %s %s #-}" pragma extension)))
+ (when (y-or-n-p (format "Add %s to the top of the file? " string))
+ (haskell-process-find-file session file)
+ (save-excursion
+ (goto-char (point-min))
+ (insert (concat string "\n"))))))
+
+(defun haskell-interactive-mode-insert-error (response)
+ "Insert an error message."
+ (insert "\n"
+ (haskell-fontify-as-mode
+ response
+ 'haskell-mode))
+ (haskell-interactive-mode-prompt))
+
+(defun haskell-interactive-popup-error (response)
+ "Popup an error."
+ (if haskell-interactive-popup-errors
+ (let ((buf (get-buffer-create "*HS-Error*")))
+ (pop-to-buffer buf nil t)
+ (with-current-buffer buf
+
+ (haskell-error-mode)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (propertize response
+ 'font-lock-face
+ 'haskell-interactive-face-compile-error))
+ (goto-char (point-min))
+ (delete-blank-lines)
+ (insert (propertize "-- Hit `q' to close this window.\n\n"
+ 'font-lock-face 'font-lock-comment-face))
+ (save-excursion
+ (goto-char (point-max))
+ (insert (propertize "\n-- To disable popups, customize `haskell-interactive-popup-errors'.\n\n"
+ 'font-lock-face 'font-lock-comment-face))))))
+ (haskell-interactive-mode-insert-error response)))
+
(defun haskell-interactive-next-error-function (&optional n reset)
"See `next-error-function' for more information."
- (let* ((session (haskell-session))
+ (let* ((session (haskell-interactive-session))
(next-error-region (haskell-session-get session 'next-error-region))
(next-error-locus (haskell-session-get session 'next-error-locus))
(reset-locus nil))
@@ -887,70 +696,25 @@ SESSION, otherwise operate on the current buffer.
(compilation-goto-locus msgmrk m1 (and (marker-position m2) m2)))
(error "don't know where to find %S" file)))))))
-(defun haskell-interactive-mode-delete-compile-messages (session &optional file-name)
- "Delete compile messages in REPL buffer.
-If FILE-NAME is non-nil, restrict to removing messages concerning
-FILE-NAME only."
- (with-current-buffer (haskell-session-interactive-buffer session)
- (save-excursion
- (goto-char (point-min))
- (when (search-forward-regexp "^Compilation failed.$" nil t 1)
- (let ((inhibit-read-only t))
- (delete-region (line-beginning-position)
- (1+ (line-end-position))))
- (goto-char (point-min)))
- (while (when (re-search-forward haskell-interactive-mode-error-regexp nil t)
- (let ((msg-file-name (match-string-no-properties 1))
- (msg-startpos (line-beginning-position)))
- ;; skip over hanging continuation message lines
- (while (progn (forward-line) (looking-at "^[ ]+")))
-
- (when (or (not file-name) (string= file-name msg-file-name))
- (let ((inhibit-read-only t))
- (set-text-properties msg-startpos (point) nil))
- (delete-region msg-startpos (point))
- ))
- t)))))
-
-(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)))))
-
-;;;###autoload
-(defun haskell-interactive-mode-reset-error (session)
- "Reset the error cursor position."
- (interactive)
- (with-current-buffer (haskell-session-interactive-buffer session)
- (haskell-interactive-mode-goto-end-point)
- (let ((mrk (point-marker)))
- (haskell-session-set session 'next-error-locus nil)
- (haskell-session-set session 'next-error-region (cons mrk (copy-marker mrk t))))
- (goto-char (point-max))))
-
-(defun haskell-interactive-kill ()
- "Kill the buffer and (maybe) the session."
- (interactive)
- (when (eq major-mode 'haskell-interactive-mode)
- (when (and (boundp 'haskell-session)
- haskell-session
- (y-or-n-p "Kill the whole session?"))
- (haskell-session-kill t))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Presentation
+(defun haskell-interactive-session ()
+ "Get the `haskell-session', throw an error if it's not
+ available."
+ (or (haskell-session-maybe)
+ (haskell-session-assign
+ (or (haskell-session-from-buffer)
+ (haskell-session-choose)
+ (error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug.")))))
+
+(defun haskell-interactive-process ()
+ "Get the Haskell session."
+ (or (haskell-session-process (haskell-interactive-session))
+ (error "No Haskell session/process associated with this
+ buffer. Maybe run M-x haskell-process-restart?")))
(defun haskell-interactive-mode-do-presentation (expr)
"Present the given expression. Requires the `present` package
to be installed. Will automatically import it qualified as Present."
- (let ((p (haskell-process)))
+ (let ((p (haskell-interactive-process)))
;; If Present.code isn't available, we probably need to run the
;; setup.
(unless (string-match "^Present" (haskell-process-queue-sync-request p ":t Present.encode"))
@@ -960,7 +724,7 @@ FILE-NAME only."
(let ((error (haskell-process-queue-sync-request
p (concat "let it = Present.asData (" expr ")"))))
(if (not (string= "" error))
- (haskell-interactive-mode-eval-result (haskell-session) (concat error "\n"))
+ (haskell-interactive-mode-eval-result (haskell-interactive-session) (concat error "\n"))
(let ((hash (haskell-interactive-mode-presentation-hash)))
(haskell-process-queue-sync-request
p (format "let %s = Present.asData (%s)" hash expr))
@@ -969,22 +733,29 @@ FILE-NAME only."
(list 0))))
(insert "\n")
(haskell-interactive-mode-insert-presentation hash presentation)
- (haskell-interactive-mode-eval-result (haskell-session) "\n"))))
- (haskell-interactive-mode-prompt (haskell-session)))))
-
-(defvar haskell-interactive-mode-presentation-hash 0
- "Counter for the hash.")
-
-(defun haskell-interactive-mode-presentation-hash ()
- "Generate a presentation hash."
- (format "_present_%s"
- (setq haskell-interactive-mode-presentation-hash
- (1+ haskell-interactive-mode-presentation-hash))))
+ (haskell-interactive-mode-eval-result (haskell-interactive-session) "\n"))))
+ (haskell-interactive-mode-prompt (haskell-interactive-session)))))
-(define-button-type 'haskell-presentation-slot-button
- 'action 'haskell-presentation-present-slot
- 'follow-link t
- 'help-echo "Click to expand…")
+(defun haskell-interactive-mode-present-id (hash id)
+ "Generate a presentation for the current expression at ID."
+ ;; See below for commentary of this statement.
+ (let ((p (haskell-interactive-process)))
+ (haskell-process-queue-without-filters
+ p "let _it = it")
+ (let* ((text (haskell-process-queue-sync-request
+ p
+ (format "Present.putStr (Present.encode (Present.fromJust (Present.present (Present.fromJust (Present.fromList [%s])) %s)))"
+ (mapconcat 'identity (mapcar 'number-to-string id) ",")
+ hash)))
+ (reply
+ (if (string-match "^*** " text)
+ '((rep nil))
+ (read text))))
+ ;; Not necessary, but nice to restore it to the expression that
+ ;; the user actually typed in.
+ (haskell-process-queue-without-filters
+ p "let it = _it")
+ reply)))
(defun haskell-presentation-present-slot (btn)
"The callback to evaluate the slot and present it in place of the button."
@@ -1108,27 +879,6 @@ they're both up to date, or report a bug."))
(insert err)
(error err))))))
-(defun haskell-interactive-mode-present-id (hash id)
- "Generate a presentation for the current expression at ID."
- ;; See below for commentary of this statement.
- (let ((p (haskell-process)))
- (haskell-process-queue-without-filters
- p "let _it = it")
- (let* ((text (haskell-process-queue-sync-request
- p
- (format "Present.putStr (Present.encode (Present.fromJust (Present.present (Present.fromJust (Present.fromList [%s])) %s)))"
- (mapconcat 'identity (mapcar 'number-to-string id) ",")
- hash)))
- (reply
- (if (string-match "^*** " text)
- '((rep nil))
- (read text))))
- ;; Not necessary, but nice to restore it to the expression that
- ;; the user actually typed in.
- (haskell-process-queue-without-filters
- p "let it = _it")
- reply)))
-
(defun haskell-interactive-mode-setup-presentation (p)
"Setup the GHCi REPL for using presentations.
@@ -1145,10 +895,179 @@ don't care when the thing completes as long as it's soonish."
(haskell-process-queue-without-filters
p "Present.present (Present.fromJust (Present.fromList [0])) ()"))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Misc
+(defvar haskell-interactive-mode-presentation-hash 0
+ "Counter for the hash.")
+
+(defun haskell-interactive-mode-presentation-hash ()
+ "Generate a presentation hash."
+ (format "_present_%s"
+ (setq haskell-interactive-mode-presentation-hash
+ (1+ haskell-interactive-mode-presentation-hash))))
+
+(define-button-type 'haskell-presentation-slot-button
+ 'action 'haskell-presentation-present-slot
+ 'follow-link t
+ 'help-echo "Click to expand…")
+
+(defun haskell-interactive-mode-history-toggle (n)
+ "Toggle the history n items up or down."
+ (unless (null haskell-interactive-mode-history)
+ (setq haskell-interactive-mode-history-index
+ (mod (+ haskell-interactive-mode-history-index n)
+ (length haskell-interactive-mode-history)))
+ (unless (zerop haskell-interactive-mode-history-index)
+ (message "History item: %d" haskell-interactive-mode-history-index))
+ (haskell-interactive-mode-set-prompt
+ (nth haskell-interactive-mode-history-index
+ haskell-interactive-mode-history))))
+
+(defun haskell-interactive-mode-set-prompt (p)
+ "Set (and overwrite) the current prompt."
+ (with-current-buffer (haskell-session-interactive-buffer (haskell-interactive-session))
+ (goto-char haskell-interactive-mode-prompt-start)
+ (delete-region (point) (point-max))
+ (insert p)))
+
+(defun haskell-interactive-mode-history-previous (arg)
+ "Cycle backwards through input history."
+ (interactive "*p")
+ (when (haskell-interactive-at-prompt)
+ (if (not (zerop arg))
+ (haskell-interactive-mode-history-toggle arg)
+ (setq haskell-interactive-mode-history-index 0)
+ (haskell-interactive-mode-history-toggle 1))))
+
+(defun haskell-interactive-mode-history-next (arg)
+ "Cycle forward through input history."
+ (interactive "*p")
+ (when (haskell-interactive-at-prompt)
+ (if (not (zerop arg))
+ (haskell-interactive-mode-history-toggle (- arg))
+ (setq haskell-interactive-mode-history-index 0)
+ (haskell-interactive-mode-history-toggle -1))))
+
+(defun haskell-interactive-mode-clear ()
+ "Clear the screen and put any current input into the history."
+ (interactive)
+ (let ((session (haskell-interactive-session)))
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (let ((inhibit-read-only t))
+ (set-text-properties (point-min) (point-max) nil))
+ (delete-region (point-min) (point-max))
+ (remove-overlays)
+ (haskell-interactive-mode-prompt session)
+ (haskell-session-set session 'next-error-region nil)
+ (haskell-session-set session 'next-error-locus nil))
+ (with-current-buffer (get-buffer-create "*haskell-process-log*")
+ (delete-region (point-min) (point-max))
+ (remove-overlays))))
+
+(defun haskell-interactive-mode-completion-at-point-function ()
+ "Offer completions for partial expression between prompt and point"
+ (when (haskell-interactive-at-prompt)
+ (let* ((process (haskell-interactive-process))
+ (session (haskell-interactive-session))
+ (inp (haskell-interactive-mode-input-partial)))
+ (if (string= inp (car-safe haskell-interactive-mode-completion-cache))
+ (cdr haskell-interactive-mode-completion-cache)
+ (let* ((resp2 (haskell-process-get-repl-completions process inp))
+ (rlen (- (length inp) (length (car resp2))))
+ (coll (append (if (string-prefix-p inp "import") '("import"))
+ (if (string-prefix-p inp "let") '("let"))
+ (cdr resp2)))
+ (result (list (- (point) rlen) (point) coll)))
+ (setq haskell-interactive-mode-completion-cache (cons inp result))
+ result)))))
-(add-hook 'kill-buffer-hook 'haskell-interactive-kill)
+(defun haskell-interactive-mode-trigger-compile-error (state response)
+ "Look for an compile error; if there is one, pop
+ that up in a buffer, similar to `debug-on-error'."
+ (when (and haskell-interactive-types-for-show-ambiguous
+ (string-match "^\n:[0-9]+:[0-9]+:" response)
+ (not (string-match "^\n:[0-9]+:[0-9]+:[\n ]+Warning:" response)))
+ (let ((inhibit-read-only t))
+ (delete-region haskell-interactive-mode-prompt-start (point))
+ (set-marker haskell-interactive-mode-prompt-start
+ haskell-interactive-mode-old-prompt-start)
+ (goto-char (point-max)))
+ (cond
+ ((and (not (haskell-interactive-mode-line-is-query (elt state 2)))
+ (or (string-match "No instance for (?Show[ \n]" response)
+ (string-match "Ambiguous type variable " response)))
+ (haskell-process-reset (haskell-interactive-process))
+ (let ((resp (haskell-process-queue-sync-request
+ (haskell-interactive-process)
+ (concat ":t "
+ (buffer-substring-no-properties
+ haskell-interactive-mode-prompt-start
+ (point-max))))))
+ (cond
+ ((not (string-match ":" resp))
+ (haskell-interactive-mode-insert-error resp))
+ (t (haskell-interactive-popup-error response)))))
+ (t (haskell-interactive-popup-error response)
+ t))
+ t))
+
+;;;###autoload
+(defun haskell-interactive-mode-echo (session message &optional mode)
+ "Echo a read only piece of text before the prompt."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (save-excursion
+ (haskell-interactive-mode-goto-end-point)
+ (insert (if mode
+ (haskell-fontify-as-mode
+ (concat message "\n")
+ mode)
+ (propertize (concat message "\n")
+ 'read-only t
+ 'rear-nonsticky t))))))
+
+(defun haskell-interactive-mode-compile-splice (session message)
+ "Echo a compiler splice."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (setq next-error-last-buffer (current-buffer))
+ (save-excursion
+ (haskell-interactive-mode-goto-end-point)
+ (insert (haskell-fontify-as-mode message 'haskell-mode)
+ "\n"))))
+
+(defun haskell-interactive-mode-insert-garbage (session message)
+ "Echo a read only piece of text before the prompt."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (save-excursion
+ (haskell-interactive-mode-goto-end-point)
+ (insert (propertize message
+ 'font-lock-face 'haskell-interactive-face-garbage
+ 'read-only t
+ 'rear-nonsticky t)))))
+
+;;;###autoload
+(defun haskell-process-do-simple-echo (line &optional mode)
+ "Send LINE to the GHCi process and echo the result in some
+fashion, such as printing in the minibuffer, or using
+haskell-present, depending on configuration."
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list process line mode)
+ :go (lambda (state)
+ (haskell-process-send-string (car state) (cadr state)))
+ :complete (lambda (state response)
+ ;; TODO: TBD: don't do this if
+ ;; `haskell-process-use-presentation-mode' is t.
+ (haskell-interactive-mode-echo
+ (haskell-process-session (car state))
+ response
+ (cl-caddr state))
+ (if haskell-process-use-presentation-mode
+ (progn (haskell-present (cadr state)
+ (haskell-process-session (car state))
+ response)
+ (haskell-session-assign
+ (haskell-process-session (car state))))
+ (haskell-mode-message-line response)))))))
(provide 'haskell-interactive-mode)
diff --git a/haskell-load.el b/haskell-load.el
new file mode 100644
index 000000000..6e96ddb90
--- /dev/null
+++ b/haskell-load.el
@@ -0,0 +1,387 @@
+;;; haskell-load.el --- Compiling and loading modules in the GHCi process
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; 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 .
+
+;;; Code:
+
+(require 'haskell-process)
+(require 'haskell-interactive-mode)
+(require 'haskell-commands)
+
+(defun haskell-process-look-config-changes (session)
+ "Checks whether a cabal configuration file has
+changed. Restarts the process if that is the case."
+ (let ((current-checksum (haskell-session-get session 'cabal-checksum))
+ (new-checksum (haskell-cabal-compute-checksum
+ (haskell-session-get session 'cabal-dir))))
+ (when (not (string= current-checksum new-checksum))
+ (haskell-interactive-mode-echo session (format "Cabal file changed: %s" new-checksum))
+ (haskell-session-set-cabal-checksum session
+ (haskell-session-get session 'cabal-dir))
+ (unless (and haskell-process-prompt-restart-on-cabal-change
+ (not (y-or-n-p "Cabal file changed; restart GHCi process? ")))
+ (haskell-process-start (haskell-interactive-session))))))
+
+(defun haskell-process-live-build (process buffer echo-in-repl)
+ "Show live updates for loading files."
+ (cond ((haskell-process-consume
+ process
+ (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
+ " Compiling \\([^ ]+\\)[ ]+"
+ "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
+ (haskell-process-echo-load-message process buffer echo-in-repl nil)
+ t)
+ ((haskell-process-consume
+ process
+ (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
+ " Compiling \\[TH\\] \\([^ ]+\\)[ ]+"
+ "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
+ (haskell-process-echo-load-message process buffer echo-in-repl t)
+ t)
+ ((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n")
+ (haskell-mode-message-line
+ (format "Loading: %s"
+ (match-string 1 buffer)))
+ t)
+ ((haskell-process-consume
+ process
+ "^Preprocessing executables for \\(.+?\\)\\.\\.\\.")
+ (let ((msg (format "Preprocessing: %s" (match-string 1 buffer))))
+ (haskell-interactive-mode-echo
+ (haskell-process-session process)
+ msg)
+ (haskell-mode-message-line msg)))
+ ((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.")
+ (let ((msg (format "Linking: %s" (match-string 1 buffer))))
+ (haskell-interactive-mode-echo (haskell-process-session process) msg)
+ (haskell-mode-message-line msg)))
+ ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.")
+ (let ((msg (format "Building: %s" (match-string 1 buffer))))
+ (haskell-interactive-mode-echo
+ (haskell-process-session process)
+ msg)
+ (haskell-mode-message-line msg)))))
+
+(defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont)
+ "Handle the complete loading response. BUFFER is the string of
+text being sent over the process pipe. MODULE-BUFFER is the
+actual Emacs buffer of the module being loaded."
+ (cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)\\.$")
+ (let* ((modules (haskell-process-extract-modules buffer))
+ (cursor (haskell-process-response-cursor process)))
+ (haskell-process-set-response-cursor process 0)
+ (let ((warning-count 0))
+ (while (haskell-process-errors-warnings session process buffer)
+ (setq warning-count (1+ warning-count)))
+ (haskell-process-set-response-cursor process cursor)
+ (if (and (not reload)
+ haskell-process-reload-with-fbytecode)
+ (haskell-process-reload-with-fbytecode process module-buffer)
+ (haskell-process-import-modules process (car modules)))
+ (haskell-mode-message-line
+ (if reload "Reloaded OK." "OK."))
+ (when cont
+ (condition-case e
+ (funcall cont t)
+ (error (message "%S" e))
+ (quit nil))))))
+ ((haskell-process-consume process "Failed, modules loaded: \\(.+\\)\\.$")
+ (let* ((modules (haskell-process-extract-modules buffer))
+ (cursor (haskell-process-response-cursor process)))
+ (haskell-process-set-response-cursor process 0)
+ (while (haskell-process-errors-warnings session process buffer))
+ (haskell-process-set-response-cursor process cursor)
+ (if (and (not reload) haskell-process-reload-with-fbytecode)
+ (haskell-process-reload-with-fbytecode process module-buffer)
+ (haskell-process-import-modules process (car modules)))
+ (haskell-interactive-mode-compile-error session "Compilation failed.")
+ (when cont
+ (condition-case e
+ (funcall cont nil)
+ (error (message "%S" e))
+ (quit nil)))))))
+
+(defun haskell-process-suggest-imports (session file modules ident)
+ "Given a list of MODULES, suggest adding them to the import section."
+ (cl-assert session)
+ (cl-assert file)
+ (cl-assert ident)
+ (let* ((process (haskell-session-process session))
+ (suggested-already (haskell-process-suggested-imports process))
+ (module (cond ((> (length modules) 1)
+ (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?"
+ ident))
+ (haskell-complete-module-read "Module: " modules)))
+ ((= (length modules) 1)
+ (let ((module (car modules)))
+ (unless (member module suggested-already)
+ (haskell-process-set-suggested-imports process (cons module suggested-already))
+ (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?"
+ ident
+ module))
+ module)))))))
+ (when module
+ (haskell-process-find-file session file)
+ (save-excursion
+ (goto-char (point-max))
+ (haskell-navigate-imports)
+ (insert (read-from-minibuffer "Import line: " (concat "import " module))
+ "\n")
+ (haskell-sort-imports)
+ (haskell-align-imports)))))
+
+(defun haskell-process-trigger-suggestions (session msg file line)
+ "Trigger prompting to add any extension suggestions."
+ (cond ((let ((case-fold-search nil))
+ (or (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg)
+ (not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg)))
+ (string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg)
+ (string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg)
+ (string-match "use \\([A-Z][A-Za-z]+\\)" msg)
+ (string-match "You need \\([A-Z][A-Za-z]+\\)" msg)))
+ (when haskell-process-suggest-language-pragmas
+ (haskell-process-suggest-pragma session "LANGUAGE" (match-string 1 msg) file)))
+ ((string-match " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant" msg)
+ (when haskell-process-suggest-remove-import-lines
+ (haskell-process-suggest-remove-import session
+ file
+ (match-string 2 msg)
+ line)))
+ ((string-match "Warning: orphan instance: " msg)
+ (when haskell-process-suggest-no-warn-orphans
+ (haskell-process-suggest-pragma session "OPTIONS" "-fno-warn-orphans" file)))
+ ((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg)
+ (string-match "with actual type [‘`‛]\\[Char\\]['’]" msg))
+ (when haskell-process-suggest-overloaded-strings
+ (haskell-process-suggest-pragma session "LANGUAGE" "OverloadedStrings" file)))
+ ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg)
+ (let* ((match1 (match-string 1 msg))
+ (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1)
+ ;; Skip qualification.
+ (match-string 1 match1)
+ match1)))
+ (when haskell-process-suggest-hoogle-imports
+ (let ((modules (haskell-process-hoogle-ident ident)))
+ (haskell-process-suggest-imports session file modules ident)))
+ (when haskell-process-suggest-haskell-docs-imports
+ (let ((modules (haskell-process-haskell-docs-ident ident)))
+ (haskell-process-suggest-imports session file modules ident)))
+ (when haskell-process-suggest-hayoo-imports
+ (let ((modules (haskell-process-hayoo-ident ident)))
+ (haskell-process-suggest-imports session file modules ident)))))
+ ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\(.+\\)['’].$" msg)
+ (when haskell-process-suggest-add-package
+ (haskell-process-suggest-add-package session msg)))))
+
+(defun haskell-process-do-cabal (command)
+ "Run a Cabal command."
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list (haskell-interactive-session) process command 0)
+
+ :go
+ (lambda (state)
+ (haskell-process-send-string
+ (cadr state)
+ (format haskell-process-do-cabal-format-string
+ (haskell-session-cabal-dir (car state))
+ (format "%s %s"
+ (cl-ecase (haskell-process-type)
+ ('ghci haskell-process-path-cabal)
+ ('cabal-repl haskell-process-path-cabal)
+ ('cabal-ghci haskell-process-path-cabal)
+ ('cabal-dev haskell-process-path-cabal-dev))
+ (cl-caddr state)))))
+
+ :live
+ (lambda (state buffer)
+ (let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*"
+ "\\1"
+ (cl-caddr state))))
+ (cond ((or (string= cmd "build")
+ (string= cmd "install"))
+ (haskell-process-live-build (cadr state) buffer t))
+ (t
+ (haskell-process-cabal-live state buffer)))))
+
+ :complete
+ (lambda (state response)
+ (let* ((process (cadr state))
+ (session (haskell-process-session process))
+ (message-count 0)
+ (cursor (haskell-process-response-cursor process)))
+ (haskell-process-set-response-cursor process 0)
+ (while (haskell-process-errors-warnings session process response)
+ (setq message-count (1+ message-count)))
+ (haskell-process-set-response-cursor process cursor)
+ (let ((msg (format "Complete: cabal %s (%s compiler messages)"
+ (cl-caddr state)
+ message-count)))
+ (haskell-interactive-mode-echo session msg)
+ (when (= message-count 0)
+ (haskell-interactive-mode-echo
+ session
+ "No compiler messages, dumping complete output:")
+ (haskell-interactive-mode-echo session response))
+ (haskell-mode-message-line msg)
+ (when (and haskell-notify-p
+ (fboundp 'notifications-notify))
+ (notifications-notify
+ :title (format "*%s*" (haskell-session-name (car state)))
+ :body msg
+ :app-name (cl-ecase (haskell-process-type)
+ ('ghci haskell-process-path-cabal)
+ ('cabal-repl haskell-process-path-cabal)
+ ('cabal-ghci haskell-process-path-cabal)
+ ('cabal-dev haskell-process-path-cabal-dev))
+ :app-icon haskell-process-logo)))))))))
+
+(defun haskell-process-echo-load-message (process buffer echo-in-repl th)
+ "Echo a load message."
+ (let ((session (haskell-process-session process))
+ (module-name (match-string 3 buffer))
+ (file-name (match-string 4 buffer)))
+ (haskell-interactive-show-load-message
+ session
+ 'compiling
+ module-name
+ (haskell-session-strip-dir session file-name)
+ echo-in-repl
+ th)))
+
+(defun haskell-process-extract-modules (buffer)
+ "Extract the modules from the process buffer."
+ (let* ((modules-string (match-string 1 buffer))
+ (modules (split-string modules-string ", ")))
+ (cons modules modules-string)))
+
+(defun haskell-process-errors-warnings (session process buffer)
+ "Trigger handling type errors or warnings."
+ (cond
+ ((haskell-process-consume
+ process
+ "\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed")
+ (let ((err (match-string 1 buffer)))
+ (when (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err)
+ (let* ((default-directory (haskell-session-current-dir session))
+ (module (match-string 1 err))
+ (file (match-string 2 err))
+ (relative-file-name (file-relative-name file)))
+ (haskell-interactive-show-load-message
+ session
+ 'import-cycle
+ module
+ relative-file-name
+ nil
+ nil)
+ (haskell-interactive-mode-compile-error
+ session
+ (format "%s:1:0: %s"
+ relative-file-name
+ err)))))
+ t)
+ ((haskell-process-consume
+ process
+ (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):"
+ "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]"))
+ (haskell-process-set-response-cursor process
+ (- (haskell-process-response-cursor process) 1))
+ (let* ((buffer (haskell-process-response process))
+ (file (match-string 1 buffer))
+ (location (match-string 2 buffer))
+ (error-msg (match-string 3 buffer))
+ (warning (string-match "^Warning:" error-msg))
+ (splice (string-match "^Splicing " error-msg))
+ (final-msg (format "%s:%s: %s"
+ (haskell-session-strip-dir session file)
+ location
+ error-msg)))
+ (funcall (cond (warning
+ 'haskell-interactive-mode-compile-warning)
+ (splice
+ 'haskell-interactive-mode-compile-splice)
+ (t 'haskell-interactive-mode-compile-error))
+ session final-msg)
+ (unless warning
+ (haskell-mode-message-line final-msg))
+ (haskell-process-trigger-suggestions
+ session
+ error-msg
+ file
+ (plist-get (haskell-process-parse-error final-msg) :line)))
+ t)))
+
+(defun haskell-interactive-show-load-message (session type module-name file-name echo th)
+ "Show the '(Compiling|Loading) X' message."
+ (let ((msg (concat
+ (cl-ecase type
+ ('compiling
+ (if haskell-interactive-mode-include-file-name
+ (format "Compiling: %s (%s)" module-name file-name)
+ (format "Compiling: %s" module-name)))
+ ('loading (format "Loading: %s" module-name))
+ ('import-cycle (format "Module has an import cycle: %s" module-name)))
+ (if th " [TH]" ""))))
+ (haskell-mode-message-line msg)
+ (when haskell-interactive-mode-delete-superseded-errors
+ (haskell-interactive-mode-delete-compile-messages session file-name))
+ (when echo
+ (haskell-interactive-mode-echo session msg))))
+
+(defun haskell-process-reload-devel-main ()
+ "Reload the module `DevelMain' and then run
+`DevelMain.update'. This is for doing live update of the code of
+servers or GUI applications. Put your development version of the
+program in `DevelMain', and define `update' to auto-start the
+program on a new thread, and use the `foreign-store' package to
+access the running context across :load/:reloads in GHCi."
+ (interactive)
+ (with-current-buffer (or (get-buffer "DevelMain.hs")
+ (if (y-or-n-p "You need to open a buffer named DevelMain.hs. Find now?")
+ (ido-find-file)
+ (error "No DevelMain.hs buffer.")))
+ (let ((session (haskell-interactive-session)))
+ (let ((process (haskell-interactive-process)))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list :session session
+ :process process
+ :buffer (current-buffer))
+ :go (lambda (state)
+ (haskell-process-send-string (plist-get state ':process)
+ ":l DevelMain"))
+ :live (lambda (state buffer)
+ (haskell-process-live-build (plist-get state ':process)
+ buffer
+ nil))
+ :complete (lambda (state response)
+ (haskell-process-load-complete
+ (plist-get state ':session)
+ (plist-get state ':process)
+ response
+ nil
+ (plist-get state ':buffer)
+ (lambda (ok)
+ (when ok
+ (haskell-process-queue-without-filters
+ (haskell-interactive-process)
+ "DevelMain.update")
+ (message "DevelMain updated.")))))))))))
+
+(provide 'haskell-load)
diff --git a/haskell-menu.el b/haskell-menu.el
index 567027c26..87770a8e7 100644
--- a/haskell-menu.el
+++ b/haskell-menu.el
@@ -31,6 +31,7 @@
(require 'haskell-compat)
(require 'haskell-session)
(require 'haskell-process)
+(require 'haskell-interactive-mode)
(defcustom haskell-menu-buffer-name "*haskell-menu*"
"The name of the Haskell session menu buffer"
diff --git a/haskell-mode.el b/haskell-mode.el
index 5017dac25..c11631ef5 100644
--- a/haskell-mode.el
+++ b/haskell-mode.el
@@ -124,6 +124,7 @@
;;; Code:
+(require 'haskell-customize)
(require 'ansi-color)
(require 'dabbrev)
(require 'compile)
@@ -137,20 +138,6 @@
(require 'haskell-sort-imports)
(require 'haskell-string)
-;; FIXME: code-smell: too many forward decls for haskell-session are required here
-(defvar haskell-session)
-(declare-function haskell-process "haskell-process" ())
-(declare-function interactive-haskell-mode "haskell-process" (&optional arg))
-(declare-function haskell-process-do-try-info "haskell-process" (sym))
-(declare-function haskell-process-queue-sync-request (process reqstr))
-(declare-function haskell-process-generate-tags "haskell-process" (&optional and-then-find-this-tag))
-(declare-function haskell-session "haskell-session" ())
-(declare-function haskell-session-all-modules "haskell-session" (&optional DONTCREATE))
-(declare-function haskell-session-cabal-dir "haskell-session" (session &optional no-prompt))
-(declare-function haskell-session-maybe "haskell-session" ())
-(declare-function haskell-session-tags-filename "haskell-session" (session))
-(declare-function haskell-session-current-dir "haskell-session" (session))
-
;; All functions/variables start with `(literate-)haskell-'.
;; Version of mode.
@@ -160,10 +147,6 @@
(defconst haskell-git-version "@GIT_VERSION@"
"The Git version of `haskell-mode'.")
-(defvar haskell-mode-pkg-base-dir (file-name-directory load-file-name)
- "Package base directory of installed `haskell-mode'.
-Used for locating additional package data files.")
-
;;;###autoload
(defun haskell-version (&optional here)
"Show the `haskell-mode` version in the echo area.
@@ -191,23 +174,6 @@ When MESSAGE is non-nil, display a message with the version."
(outline-next-visible-heading 1)
(show-subtree)))
-(defgroup haskell nil
- "Major mode for editing Haskell programs."
- :link '(custom-manual "(haskell-mode)")
- :group 'languages
- :prefix "haskell-")
-
-;;;###autoload
-(defun haskell-customize ()
- "Browse the haskell customize sub-tree.
-This calls 'customize-browse' with haskell as argument and makes
-sure all haskell customize definitions have been loaded."
- (interactive)
- ;; make sure all modules with (defcustom ...)s are loaded
- (mapc 'require
- '(haskell-checkers haskell-compile haskell-doc haskell-font-lock haskell-indentation haskell-indent haskell-interactive-mode haskell-menu haskell-process haskell-yas inf-haskell))
- (customize-browse 'haskell))
-
;; Are we looking at a literate script?
(defvar haskell-literate nil
"*If not nil, the current buffer contains a literate Haskell script.
@@ -708,15 +674,6 @@ is asked to show extra info for the items matching QUERY.."
(const "ghc -fno-code")
(string :tag "Other command")))
-(defcustom haskell-completing-read-function 'ido-completing-read
- "Default function to use for completion."
- :group 'haskell
- :type '(choice
- (function-item :tag "ido" :value ido-completing-read)
- (function-item :tag "helm" :value helm--completing-read-default)
- (function-item :tag "completing-read" :value completing-read)
- (function :tag "Custom function")))
-
(defcustom haskell-stylish-on-save nil
"Whether to run stylish-haskell on the buffer before saving."
:group 'haskell
@@ -731,7 +688,8 @@ is asked to show extra info for the items matching QUERY.."
"Internal use.")
(defcustom haskell-indent-spaces 2
- "Number of spaces to indent inwards.")
+ "Number of spaces to indent inwards."
+ :group 'haskell)
;; Like Python. Should be abstracted, sigh.
(defun haskell-check (command)
@@ -778,269 +736,10 @@ Run M-x describe-variable haskell-mode-hook for a list of such modes."))
(goto-char (+ (line-beginning-position)
col))))
-(defun haskell-mode-message-line (str)
- "Message only one line, multiple lines just disturbs the programmer."
- (let ((lines (split-string str "\n" t)))
- (when (and (car lines) (stringp (car lines)))
- (message "%s"
- (concat (car lines)
- (if (and (cdr lines) (stringp (cadr lines)))
- (format " [ %s .. ]" (haskell-string-take (haskell-trim (cadr lines)) 10))
- ""))))))
-
-(defun haskell-mode-contextual-space ()
- "Contextually do clever stuff when hitting space."
- (interactive)
- (if (or (not (bound-and-true-p interactive-haskell-mode))
- (not (haskell-session-maybe)))
- (self-insert-command 1)
- (cond ((and haskell-mode-contextual-import-completion
- (save-excursion (forward-word -1)
- (looking-at "^import$")))
- (insert " ")
- (let ((module (haskell-complete-module-read "Module: " (haskell-session-all-modules))))
- (insert module)
- (haskell-mode-format-imports)))
- ((not (string= "" (save-excursion (forward-char -1) (haskell-ident-at-point))))
- (let ((ident (save-excursion (forward-char -1) (haskell-ident-at-point))))
- (insert " ")
- (haskell-process-do-try-info ident)))
- (t (insert " ")))))
-
(defun haskell-mode-before-save-handler ()
"Function that will be called before buffer's saving."
)
-(defun haskell-mode-after-save-handler ()
- "Function that will be called after buffer's saving."
- (when haskell-tags-on-save
- (ignore-errors (when (and (boundp 'haskell-session) haskell-session)
- (haskell-process-generate-tags))))
- (when haskell-stylish-on-save
- (ignore-errors (haskell-mode-stylish-buffer))
- (let ((before-save-hook '())
- (after-save-hook '()))
- (basic-save-buffer))))
-
-(defun haskell-mode-buffer-apply-command (cmd)
- "Execute shell command CMD with current buffer as input and
-replace the whole buffer with the output. If CMD fails the buffer
-remains unchanged."
- (set-buffer-modified-p t)
- (let* ((chomp (lambda (str)
- (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
- (setq str (replace-match "" t t str)))
- str))
- (errout (lambda (fmt &rest args)
- (let* ((warning-fill-prefix " "))
- (display-warning cmd (apply 'format fmt args) :warning))))
- (filename (buffer-file-name (current-buffer)))
- (cmd-prefix (replace-regexp-in-string " .*" "" cmd))
- (tmp-file (make-temp-file cmd-prefix))
- (err-file (make-temp-file cmd-prefix))
- (default-directory (if (and (boundp 'haskell-session)
- haskell-session)
- (haskell-session-cabal-dir haskell-session)
- default-directory))
- (errcode (with-temp-file tmp-file
- (call-process cmd filename
- (list (current-buffer) err-file) nil)))
- (stderr-output
- (with-temp-buffer
- (insert-file-contents err-file)
- (funcall chomp (buffer-substring-no-properties (point-min) (point-max)))))
- (stdout-output
- (with-temp-buffer
- (insert-file-contents tmp-file)
- (buffer-substring-no-properties (point-min) (point-max)))))
- (if (string= "" stderr-output)
- (if (string= "" stdout-output)
- (funcall errout
- "Error: %s produced no output, leaving buffer alone" cmd)
- (save-restriction
- (widen)
- ;; command successful, insert file with replacement to preserve
- ;; markers.
- (insert-file-contents tmp-file nil nil nil t)))
- ;; non-null stderr, command must have failed
- (funcall errout "%s failed: %s" cmd stderr-output)
- )
- (delete-file tmp-file)
- (delete-file err-file)
- ))
-
-(defun haskell-mode-stylish-buffer ()
- "Apply stylish-haskell to the current buffer."
- (interactive)
- (let ((column (current-column))
- (line (line-number-at-pos)))
- (haskell-mode-buffer-apply-command "stylish-haskell")
- (goto-char (point-min))
- (forward-line (1- line))
- (goto-char (+ column (point)))))
-
-(defun haskell-mode-goto-loc ()
- "Go to the location of the thing at point. Requires the :loc-at
-command from GHCi."
- (interactive)
- (let ((loc (haskell-mode-loc-at)))
- (when loc
- (find-file (expand-file-name (plist-get loc :path)
- (haskell-session-cabal-dir (haskell-session))))
- (goto-char (point-min))
- (forward-line (1- (plist-get loc :start-line)))
- (forward-char (plist-get loc :start-col)))))
-
-(defun haskell-mode-show-type-at (&optional insert-value)
- "Show the type of the thing at point."
- (interactive "P")
- (let ((ty (haskell-mode-type-at)))
- (if insert-value
- (progn (goto-char (line-beginning-position))
- (insert (haskell-fontify-as-mode ty 'haskell-mode)
- "\n"))
- (message "%s" (haskell-fontify-as-mode ty 'haskell-mode)))))
-
-(defun haskell-mode-loc-at ()
- "Get the location at point. Requires the :loc-at command from
-GHCi."
- (let ((pos (or (when (region-active-p)
- (cons (region-beginning)
- (region-end)))
- (haskell-ident-pos-at-point)
- (cons (point)
- (point)))))
- (when pos
- (let ((reply (haskell-process-queue-sync-request
- (haskell-process)
- (save-excursion
- (format ":loc-at %s %d %d %d %d %s"
- (buffer-file-name)
- (progn (goto-char (car pos))
- (line-number-at-pos))
- (1+ (current-column)) ;; GHC uses 1-based columns.
- (progn (goto-char (cdr pos))
- (line-number-at-pos))
- (1+ (current-column)) ;; GHC uses 1-based columns.
- (buffer-substring-no-properties (car pos)
- (cdr pos)))))))
- (if reply
- (if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
- reply)
- (list :path (match-string 1 reply)
- :start-line (string-to-number (match-string 2 reply))
- ;; ;; GHC uses 1-based columns.
- :start-col (1- (string-to-number (match-string 3 reply)))
- :end-line (string-to-number (match-string 4 reply))
- ;; GHC uses 1-based columns.
- :end-col (1- (string-to-number (match-string 5 reply))))
- (error (propertize reply 'face 'compilation-error)))
- (error (propertize "No reply. Is :loc-at supported?"
- 'face 'compilation-error)))))))
-
-(defun haskell-mode-type-at ()
- "Get the type of the thing at point. Requires the :type-at
-command from GHCi."
- (let ((pos (or (when (region-active-p)
- (cons (region-beginning)
- (region-end)))
- (haskell-ident-pos-at-point)
- (cons (point)
- (point)))))
- (when pos
- (replace-regexp-in-string
- "\n$"
- ""
- (save-excursion
- (haskell-process-queue-sync-request
- (haskell-process)
- (replace-regexp-in-string
- "\n"
- " "
- (format ":type-at %s %d %d %d %d %s"
- (buffer-file-name)
- (progn (goto-char (car pos))
- (line-number-at-pos))
- (1+ (current-column))
- (progn (goto-char (cdr pos))
- (line-number-at-pos))
- (1+ (current-column))
- (buffer-substring-no-properties (car pos)
- (cdr pos))))))))))
-
-(defun haskell-mode-jump-to-def-or-tag (&optional next-p)
- "Jump to the definition (by consulting GHCi), or (fallback)
-jump to the tag.
-
-Remember: If GHCi is busy doing something, this will delay, but
-it will always be accurate, in contrast to tags, which always
-work but are not always accurate.
-
-If the definition or tag is found, the location from which you
-jumped will be pushed onto `find-tag-marker-ring', so you can
-return to that position with `pop-tag-mark'."
- (interactive "P")
- (let ((initial-loc (point-marker))
- (loc (haskell-mode-find-def (haskell-ident-at-point))))
- (if loc
- (haskell-mode-handle-generic-loc loc)
- (call-interactively 'haskell-mode-tag-find))
- (unless (equal initial-loc (point-marker))
- ;; Store position for return with `pop-tag-mark'
- (ring-insert find-tag-marker-ring initial-loc))))
-
-(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))))
-
-(defun haskell-mode-jump-to-tag (&optional next-p)
- "Jump to the tag of the given identifier."
- (interactive "P")
- (let ((ident (haskell-ident-at-point))
- (tags-file-name (haskell-session-tags-filename (haskell-session)))
- (tags-revert-without-query t))
- (when (not (string= "" (haskell-trim ident)))
- (cond ((file-exists-p tags-file-name)
- (find-tag ident next-p))
- (t (haskell-process-generate-tags ident))))))
-
-(defun haskell-mode-jump-to-def (ident)
- "Jump to definition of identifier at point."
- (interactive (list (haskell-ident-at-point)))
- (let ((loc (haskell-mode-find-def ident)))
- (when loc
- (haskell-mode-handle-generic-loc loc))))
-
-(defun haskell-mode-handle-generic-loc (loc)
- "Either jump to or display a generic location. Either a file or
-a library."
- (cl-case (car loc)
- (file (haskell-mode-jump-to-loc (cdr loc)))
- (library (message "Defined in `%s' (%s)."
- (elt loc 2)
- (elt loc 1)))
- (module (message "Defined in `%s'."
- (elt loc 1)))))
-
(defun haskell-mode-jump-to-loc (loc)
"Jump to the given location.
LOC = (list FILE LINE COL)"
@@ -1050,44 +749,6 @@ LOC = (list FILE LINE COL)"
(goto-char (+ (line-beginning-position)
(1- (elt loc 2)))))
-(defun haskell-mode-find-def (ident)
- "Find definition location of identifier. Uses the GHCi process
-to find the location.
-
-Returns:
-
- (library )
- (file )
- (module )
-"
- (let ((reply (haskell-process-queue-sync-request
- (haskell-process)
- (format (if (string-match "^[a-zA-Z_]" ident)
- ":info %s"
- ":info (%s)")
- ident))))
- (let ((match (string-match "-- Defined \\(at\\|in\\) \\(.+\\)$" reply)))
- (when match
- (let ((defined (match-string 2 reply)))
- (let ((match (string-match "\\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)$" defined)))
- (cond
- (match
- (list 'file
- (expand-file-name (match-string 1 defined)
- (haskell-session-current-dir (haskell-session)))
- (string-to-number (match-string 2 defined))
- (string-to-number (match-string 3 defined))))
- (t
- (let ((match (string-match "`\\(.+?\\):\\(.+?\\)'$" defined)))
- (if match
- (list 'library
- (match-string 1 defined)
- (match-string 2 defined))
- (let ((match (string-match "`\\(.+?\\)'$" defined)))
- (if match
- (list 'module
- (match-string 1 defined))))))))))))))
-
;; From Bryan O'Sullivan's blog:
;; http://www.serpentine.com/blog/2007/10/09/using-emacs-to-insert-scc-annotations-in-haskell-code/
(defun haskell-mode-insert-scc-at-point ()
@@ -1123,28 +784,6 @@ Returns:
(kill-region (match-beginning 0) (match-end 0))
(error "No SCC at point")))))
-(defun haskell-rgrep (&optional prompt)
- "Grep the effective project for the symbol at point. Very
-useful for codebase navigation. Prompts for an arbitrary regexp
-given a prefix arg."
- (interactive "P")
- (let ((sym (if prompt
- (read-from-minibuffer "Look for: ")
- (haskell-ident-at-point))))
- (rgrep sym
- "*.hs" ;; TODO: common Haskell extensions.
- (haskell-session-current-dir (haskell-session)))))
-
-(defun haskell-fontify-as-mode (text mode)
- "Fontify TEXT as MODE, returning the fontified text."
- (with-temp-buffer
- (funcall mode)
- (insert text)
- (if (fboundp 'font-lock-ensure)
- (font-lock-ensure)
- (with-no-warnings (font-lock-fontify-buffer)))
- (buffer-substring (point-min) (point-max))))
-
(defun haskell-guess-module-name ()
"Guess the current module name of the buffer."
(interactive)
@@ -1177,42 +816,6 @@ given a prefix arg."
(goto-char (point-min))
(forward-char 4)))
-(defun haskell-describe (ident)
- "Describe the given identifier."
- (interactive (list (read-from-minibuffer "Describe identifier: "
- (haskell-ident-at-point))))
- (let ((results (read (shell-command-to-string
- (concat "haskell-docs --sexp "
- ident)))))
- (help-setup-xref (list #'haskell-describe ident)
- (called-interactively-p 'interactive))
- (save-excursion
- (with-help-window (help-buffer)
- (with-current-buffer (help-buffer)
- (if results
- (cl-loop for result in results
- do (insert (propertize ident 'font-lock-face
- '((:inherit font-lock-type-face
- :underline t)))
- " is defined in "
- (let ((module (cadr (assoc 'module result))))
- (if module
- (concat module " ")
- ""))
- (cadr (assoc 'package result))
- "\n\n")
- do (let ((type (cadr (assoc 'type result))))
- (when type
- (insert (haskell-fontify-as-mode type 'haskell-mode)
- "\n")))
- do (let ((args (cadr (assoc 'type results))))
- (cl-loop for arg in args
- do (insert arg "\n"))
- (insert "\n"))
- do (insert (cadr (assoc 'documentation result)))
- do (insert "\n\n"))
- (insert "No results for " ident)))))))
-
;; Provide ourselves:
diff --git a/haskell-process.el b/haskell-process.el
index bf306341a..e89c528cc 100644
--- a/haskell-process.el
+++ b/haskell-process.el
@@ -1,6 +1,6 @@
;;; haskell-process.el --- Communicating with the inferior Haskell process
-;; Copyright (C) 2011-2012 Chris Done
+;; Copyright (C) 2011 Chris Done
;; Author: Chris Done
@@ -21,214 +21,21 @@
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
-;;; Commentary:
-
-;;; Todo:
-
;;; Code:
-(require 'cl-lib)
(require 'json)
(require 'url-util)
-(require 'haskell-complete-module)
-(require 'haskell-mode)
(require 'haskell-session)
-(require 'haskell-compat)
+(require 'haskell-customize)
(require 'haskell-str)
-(require 'haskell-compile)
-(require 'haskell-utils)
-(require 'haskell-presentation-mode)
-(require 'haskell-navigate-imports)
-
-;; FIXME: haskell-process shouldn't depend on haskell-interactive-mode to avoid module-dep cycles
-(declare-function haskell-interactive-mode-echo "haskell-interactive-mode" (session message &optional mode))
-(declare-function haskell-interactive-mode-compile-error "haskell-interactive-mode" (session message))
-(declare-function haskell-interactive-mode-compile-warning "haskell-interactive-mode" (session message))
-(declare-function haskell-interactive-mode-insert "haskell-interactive-mode" (session message))
-(declare-function haskell-interactive-mode-reset-error "haskell-interactive-mode" (session))
-(declare-function haskell-interactive-show-load-message "haskell-interactive-mode" (session type module-name file-name echo th))
-(declare-function haskell-interactive-mode-insert-garbage "haskell-interactive-mode" (session message))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Configuration
-(defgroup haskell-interactive nil
- "Settings for REPL interaction via `haskell-interactive-mode'"
- :link '(custom-manual "(haskell-mode)haskell-interactive-mode")
- :group 'haskell)
-
-(defcustom haskell-process-path-ghci
- "ghci"
- "The path for starting ghci."
- :group 'haskell-interactive
- :type '(choice string (repeat string)))
-
-(defcustom haskell-process-path-cabal
- "cabal"
- "Path to the `cabal' executable."
- :group 'haskell-interactive
- :type '(choice string (repeat string)))
-
-(defcustom haskell-process-path-cabal-ghci
- "cabal-ghci"
- "The path for starting cabal-ghci."
- :group 'haskell-interactive
- :type '(choice string (repeat string)))
-
-(defcustom haskell-process-path-cabal-dev
- "cabal-dev"
- "The path for starting cabal-dev."
- :group 'haskell-interactive
- :type '(choice string (repeat string)))
-
-(defcustom haskell-process-args-ghci
- '("-ferror-spans")
- "Any arguments for starting ghci."
- :group 'haskell-interactive
- :type '(repeat (string :tag "Argument")))
-
-(defcustom haskell-process-args-cabal-repl
- '("--ghc-option=-ferror-spans")
- "Additional arguments to for `cabal repl' invocation.
-Note: The settings in `haskell-process-path-ghci' and
-`haskell-process-args-ghci' are not automatically reused as `cabal repl'
-currently invokes `ghc --interactive'. Use
-`--with-ghc=' if you want to use a different
-interactive GHC frontend; use `--ghc-option=' to
-pass additional flags to `ghc'."
- :group 'haskell-interactive
- :type '(repeat (string :tag "Argument")))
-
-(defcustom haskell-process-do-cabal-format-string
- ":!cd %s && %s"
- "The way to run cabal comands. It takes two arguments -- the directory and the command.
-See `haskell-process-do-cabal' for more details."
- :group 'haskell-interactive
- :type 'string)
-
-(defcustom haskell-process-type
- 'auto
- "The inferior Haskell process type to use."
- :type '(choice (const auto) (const ghci) (const cabal-repl) (const cabal-dev) (const cabal-ghci))
- :group 'haskell-interactive)
-
-(defcustom haskell-process-log
- nil
- "Enable debug logging to \"*haskell-process-log*\" buffer."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-show-debug-tips
- t
- "Show debugging tips when starting the process."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-notify-p
- nil
- "Notify using notifications.el (if loaded)?"
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-no-warn-orphans
- t
- "Suggest adding -fno-warn-orphans pragma to file when getting orphan warnings."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-hoogle-imports
- nil
- "Suggest to add import statements using Hoogle as a backend."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-hayoo-imports
- nil
- "Suggest to add import statements using Hayoo as a backend."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-hayoo-query-url
- "http://hayoo.fh-wedel.de/json/?query=%s"
- "Query url for json hayoo results."
- :type 'string
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-haskell-docs-imports
- nil
- "Suggest to add import statements using haskell-docs as a backend."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-add-package
- t
- "Suggest to add packages to your .cabal file when Cabal says it
-is a member of the hidden package, blah blah."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-language-pragmas
- t
- "Suggest adding LANGUAGE pragmas recommended by GHC."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-remove-import-lines
- nil
- "Suggest removing import lines as warned by GHC."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-overloaded-strings
- t
- "Suggest adding OverloadedStrings pragma to file when getting type mismatches with [Char]."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-check-cabal-config-on-load
- t
- "Check changes cabal config on loading Haskell files and
-restart the GHCi process if changed.."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-prompt-restart-on-cabal-change
- t
- "Ask whether to restart the GHCi process when the Cabal file
-has changed?"
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-auto-import-loaded-modules
- nil
- "Auto import the modules reported by GHC to have been loaded?"
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-reload-with-fbytecode
- nil
- "When using -fobject-code, auto reload with -fbyte-code (and
-then restore the -fobject-code) so that all module info and
-imports become available?"
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-use-presentation-mode
- nil
- "Use presentation mode to show things like type info instead of
- printing to the message area."
- :type 'boolean
- :group 'haskell-interactive)
-
-(defcustom haskell-process-suggest-restart
- t
- "Suggest restarting the process when it has died"
- :type 'boolean
- :group 'haskell-interactive)
-
-(defvar haskell-process-prompt-regex "\4")
-(defvar haskell-reload-p nil)
-
-(defvar haskell-process-greetings
+(defconst haskell-process-prompt-regex "\4"
+ "Used for delimiting command replies. 4 is End of Transmission.")
+
+(defvar haskell-reload-p nil
+ "Used internally for `haskell-process-loadish'.")
+
+(defconst haskell-process-greetings
(list "Hello, Haskell!"
"The lambdas must flow."
"Hours of hacking await!"
@@ -240,9 +47,9 @@ imports become available?"
(expand-file-name "logo.svg" haskell-mode-pkg-base-dir)
"Haskell logo for notifications.")
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Accessing commands -- using cl 'defstruct'
+
(cl-defstruct haskell-command
"Data structure representing a command to be executed when with
a custom state and three callback."
@@ -260,963 +67,16 @@ imports become available?"
;; complete :: a -> Response -> ()
complete)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Accessing commands
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Specialised commands
-
-;;;###autoload
-(defun haskell-process-generate-tags (&optional and-then-find-this-tag)
- "Regenerate the TAGS table."
- (interactive)
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (cons process and-then-find-this-tag)
- :go (lambda (state)
- (if (eq system-type 'windows-nt)
- (haskell-process-send-string
- (car state)
- (format ":!powershell -Command \"& { cd %s ; hasktags -e -x (ls -fi *.hs -exclude \\\"#*#\\\" -name -r) ; exit }\""
- (haskell-session-cabal-dir
- (haskell-process-session (car state)))))
- (haskell-process-send-string
- (car state)
- (format ":!cd %s && %s | %s | %s"
- (haskell-session-cabal-dir
- (haskell-process-session (car state)))
- "find . -name '*.hs*'"
- "grep -v '#'" ; To avoid Emacs back-up files. Yeah.
- "xargs hasktags -e -x"))))
- :complete (lambda (state response)
- (when (cdr state)
- (let ((tags-file-name
- (haskell-session-tags-filename
- (haskell-process-session (car state)))))
- (find-tag (cdr state))))
- (haskell-mode-message-line "Tags generated."))))))
-
-;;;###autoload
-(defun haskell-process-do-type (&optional insert-value)
- "Print the type of the given expression."
- (interactive "P")
- (if insert-value
- (haskell-process-insert-type)
- (haskell-process-do-simple-echo
- (let ((ident (haskell-ident-at-point)))
- ;; TODO: Generalize all these `string-match' of ident calls into
- ;; one function.
- (format (if (string-match "^[_[:lower:][:upper:]]" ident)
- ":type %s"
- ":type (%s)")
- ident))
- 'haskell-mode)))
-
-(defun haskell-process-insert-type ()
- "Get the identifer at the point and insert its type, if
-possible, using GHCi's :type."
- (let ((process (haskell-process))
- (query (let ((ident (haskell-ident-at-point)))
- (format (if (string-match "^[_[:lower:][:upper:]]" ident)
- ":type %s"
- ":type (%s)")
- ident))))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list process query (current-buffer))
- :go (lambda (state)
- (haskell-process-send-string (nth 0 state)
- (nth 1 state)))
- :complete (lambda (state response)
- (cond
- ;; TODO: Generalize this into a function.
- ((or (string-match "^Top level" response)
- (string-match "^" response))
- (message response))
- (t
- (with-current-buffer (nth 2 state)
- (goto-char (line-beginning-position))
- (insert (format "%s\n" (replace-regexp-in-string "\n$" "" response)))))))))))
-
-;;;###autoload
-(defun haskell-process-do-info (&optional prompt-value)
- "Print info on the identifier at point.
-If PROMPT-VALUE is non-nil, request identifier via mini-buffer."
- (interactive "P")
- (haskell-process-do-simple-echo
- (let ((ident (if prompt-value
- (read-from-minibuffer "Info: " (haskell-ident-at-point))
- (haskell-ident-at-point)))
- (modname (unless prompt-value
- (haskell-utils-parse-import-statement-at-point))))
- (if modname
- (format ":browse! %s" modname)
- (format (if (string-match "^[a-zA-Z_]" ident)
- ":info %s"
- ":info (%s)")
- (or ident
- (haskell-ident-at-point)))))
- 'haskell-mode))
-
-(defun haskell-process-do-try-info (sym)
- "Get info of `sym' and echo in the minibuffer."
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (cons process sym)
- :go (lambda (state)
- (haskell-process-send-string
- (car state)
- (if (string-match "^[A-Za-z_]" (cdr state))
- (format ":info %s" (cdr state))
- (format ":info (%s)" (cdr state)))))
- :complete (lambda (state response)
- (unless (or (string-match "^Top level" response)
- (string-match "^" response))
- (haskell-mode-message-line response)))))))
-
-(defun haskell-process-do-try-type (sym)
- "Get type of `sym' and echo in the minibuffer."
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (cons process sym)
- :go (lambda (state)
- (haskell-process-send-string
- (car state)
- (if (string-match "^[A-Za-z_]" (cdr state))
- (format ":type %s" (cdr state))
- (format ":type (%s)" (cdr state)))))
- :complete (lambda (state response)
- (unless (or (string-match "^Top level" response)
- (string-match "^" response))
- (haskell-mode-message-line response)))))))
-
-(defun haskell-process-do-simple-echo (line &optional mode)
- "Send LINE to the GHCi process and echo the result in some
-fashion, such as printing in the minibuffer, or using
-haskell-present, depending on configuration."
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list process line mode)
- :go (lambda (state)
- (haskell-process-send-string (car state) (cadr state)))
- :complete (lambda (state response)
- ;; TODO: TBD: don't do this if
- ;; `haskell-process-use-presentation-mode' is t.
- (haskell-interactive-mode-echo
- (haskell-process-session (car state))
- response
- (cl-caddr state))
- (if haskell-process-use-presentation-mode
- (progn (haskell-present (cadr state)
- (haskell-process-session (car state))
- response)
- (haskell-session-assign
- (haskell-process-session (car state))))
- (haskell-mode-message-line response)))))))
-
-(defun haskell-process-look-config-changes (session)
- "Checks whether a cabal configuration file has
-changed. Restarts the process if that is the case."
- (let ((current-checksum (haskell-session-get session 'cabal-checksum))
- (new-checksum (haskell-cabal-compute-checksum
- (haskell-session-get session 'cabal-dir))))
- (when (not (string= current-checksum new-checksum))
- (haskell-interactive-mode-echo session (format "Cabal file changed: %s" new-checksum))
- (haskell-session-set-cabal-checksum session
- (haskell-session-get session 'cabal-dir))
- (unless (and haskell-process-prompt-restart-on-cabal-change
- (not (y-or-n-p "Cabal file changed; restart GHCi process? ")))
- (haskell-process-start (haskell-session))))))
-
-;;;###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-file ()
- "Re-load the current buffer file."
- (interactive)
- (save-buffer)
- (haskell-interactive-mode-reset-error (haskell-session))
- (haskell-process-file-loadish "reload" t nil))
-
-;;;###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 .")))
- (if haskell-reload-p (haskell-process-reload-file) (haskell-process-load-file))))
-
-(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-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-add-cabal-autogen ()
- "Add /dist/build/autogen/ to the ghci search
-path. This allows modules such as 'Path_...', generated by cabal,
-to be loaded by ghci."
- (unless (eq 'cabal-repl (haskell-process-type)) ;; redundant with "cabal repl"
- (let*
- ((session (haskell-session))
- (cabal-dir (haskell-session-cabal-dir session))
- (ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir)))
- (haskell-process-queue-without-filters
- (haskell-process)
- (format ":set -i%s" ghci-gen-dir)))))
-
-(defun haskell-process-type ()
- "Return `haskell-process-type', or a guess if that variable is 'auto."
- (if (eq 'auto haskell-process-type)
- (if (locate-dominating-file
- default-directory
- (lambda (d)
- (or (file-directory-p (expand-file-name ".cabal-sandbox" d))
- (cl-find-if (lambda (f) (string-match-p ".\\.cabal\\'" f)) (directory-files d)))))
- 'cabal-repl
- 'ghci)
- haskell-process-type))
-
-(defun haskell-process-do-cabal (command)
- "Run a Cabal command."
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list (haskell-session) process command 0)
-
- :go
- (lambda (state)
- (haskell-process-send-string
- (cadr state)
- (format haskell-process-do-cabal-format-string
- (haskell-session-cabal-dir (car state))
- (format "%s %s"
- (cl-ecase (haskell-process-type)
- ('ghci haskell-process-path-cabal)
- ('cabal-repl haskell-process-path-cabal)
- ('cabal-ghci haskell-process-path-cabal)
- ('cabal-dev haskell-process-path-cabal-dev))
- (cl-caddr state)))))
-
- :live
- (lambda (state buffer)
- (let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*"
- "\\1"
- (cl-caddr state))))
- (cond ((or (string= cmd "build")
- (string= cmd "install"))
- (haskell-process-live-build (cadr state) buffer t))
- (t
- (haskell-process-cabal-live state buffer)))))
-
- :complete
- (lambda (state response)
- (let* ((process (cadr state))
- (session (haskell-process-session process))
- (message-count 0)
- (cursor (haskell-process-response-cursor process)))
- (haskell-process-set-response-cursor process 0)
- (while (haskell-process-errors-warnings session process response)
- (setq message-count (1+ message-count)))
- (haskell-process-set-response-cursor process cursor)
- (let ((msg (format "Complete: cabal %s (%s compiler messages)"
- (cl-caddr state)
- message-count)))
- (haskell-interactive-mode-echo session msg)
- (when (= message-count 0)
- (haskell-interactive-mode-echo
- session
- "No compiler messages, dumping complete output:")
- (haskell-interactive-mode-echo session response))
- (haskell-mode-message-line msg)
- (when (and haskell-notify-p
- (fboundp 'notifications-notify))
- (notifications-notify
- :title (format "*%s*" (haskell-session-name (car state)))
- :body msg
- :app-name (cl-ecase (haskell-process-type)
- ('ghci haskell-process-path-cabal)
- ('cabal-repl haskell-process-path-cabal)
- ('cabal-ghci haskell-process-path-cabal)
- ('cabal-dev haskell-process-path-cabal-dev))
- :app-icon haskell-process-logo
- )))))))))
-
-(defun haskell-process-cabal-live (state buffer)
- "Do live updates for Cabal processes."
- (haskell-interactive-mode-insert
- (haskell-process-session (cadr state))
- (replace-regexp-in-string
- haskell-process-prompt-regex
- ""
- (substring buffer (cl-cadddr state))))
- (setf (cl-cdddr state) (list (length buffer)))
- nil)
-
-(defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont)
- "Handle the complete loading response. BUFFER is the string of
-text being sent over the process pipe. MODULE-BUFFER is the
-actual Emacs buffer of the module being loaded."
- (cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)\\.$")
- (let* ((modules (haskell-process-extract-modules buffer))
- (cursor (haskell-process-response-cursor process)))
- (haskell-process-set-response-cursor process 0)
- (let ((warning-count 0))
- (while (haskell-process-errors-warnings session process buffer)
- (setq warning-count (1+ warning-count)))
- (haskell-process-set-response-cursor process cursor)
- (if (and (not reload)
- haskell-process-reload-with-fbytecode)
- (haskell-process-reload-with-fbytecode process module-buffer)
- (haskell-process-import-modules process (car modules)))
- (haskell-mode-message-line
- (if reload "Reloaded OK." "OK."))
- (when cont
- (condition-case e
- (funcall cont t)
- (error (message "%S" e))
- (quit nil))))))
- ((haskell-process-consume process "Failed, modules loaded: \\(.+\\)\\.$")
- (let* ((modules (haskell-process-extract-modules buffer))
- (cursor (haskell-process-response-cursor process)))
- (haskell-process-set-response-cursor process 0)
- (while (haskell-process-errors-warnings session process buffer))
- (haskell-process-set-response-cursor process cursor)
- (if (and (not reload) haskell-process-reload-with-fbytecode)
- (haskell-process-reload-with-fbytecode process module-buffer)
- (haskell-process-import-modules process (car modules)))
- (haskell-interactive-mode-compile-error session "Compilation failed.")
- (when cont
- (condition-case e
- (funcall cont nil)
- (error (message "%S" e))
- (quit nil)))))))
-
-(defun haskell-process-reload-with-fbytecode (process module-buffer)
- "Reload FILE-NAME with -fbyte-code set, and then restore -fobject-code."
- (haskell-process-queue-without-filters process ":set -fbyte-code")
- (haskell-process-touch-buffer process module-buffer)
- (haskell-process-queue-without-filters process ":reload")
- (haskell-process-queue-without-filters process ":set -fobject-code"))
-
-(defun haskell-process-touch-buffer (process buffer)
- "Updates mtime on the file for BUFFER by queing a touch on
-PROCESS."
- (interactive)
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (cons process buffer)
- :go (lambda (state)
- (haskell-process-send-string
- (car state)
- (format ":!%s %s"
- "touch"
- (shell-quote-argument (buffer-file-name
- (cdr state))))))
- :complete (lambda (state _)
- (with-current-buffer (cdr state)
- (clear-visited-file-modtime))))))
-
-(defun haskell-process-extract-modules (buffer)
- "Extract the modules from the process buffer."
- (let* ((modules-string (match-string 1 buffer))
- (modules (split-string modules-string ", ")))
- (cons modules modules-string)))
-
-(defun haskell-process-import-modules (process modules)
- "Import `modules' with :m +, and send any import statements
-from `module-buffer'."
- (when haskell-process-auto-import-loaded-modules
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (cons process modules)
- :go (lambda (state)
- (haskell-process-send-string
- (car state)
- (format ":m + %s" (mapconcat 'identity (cdr state) " "))))))))
-
-(defun haskell-process-live-build (process buffer echo-in-repl)
- "Show live updates for loading files."
- (cond ((haskell-process-consume
- process
- (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
- " Compiling \\([^ ]+\\)[ ]+"
- "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
- (haskell-process-echo-load-message process buffer echo-in-repl nil)
- t)
- ((haskell-process-consume
- process
- (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
- " Compiling \\[TH\\] \\([^ ]+\\)[ ]+"
- "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
- (haskell-process-echo-load-message process buffer echo-in-repl t)
- t)
- ((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n")
- (haskell-mode-message-line
- (format "Loading: %s"
- (match-string 1 buffer)))
- t)
- ((haskell-process-consume
- process
- "^Preprocessing executables for \\(.+?\\)\\.\\.\\.")
- (let ((msg (format "Preprocessing: %s" (match-string 1 buffer))))
- (haskell-interactive-mode-echo
- (haskell-process-session process)
- msg)
- (haskell-mode-message-line msg)))
- ((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.")
- (let ((msg (format "Linking: %s" (match-string 1 buffer))))
- (haskell-interactive-mode-echo (haskell-process-session process) msg)
- (haskell-mode-message-line msg)))
- ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.")
- (let ((msg (format "Building: %s" (match-string 1 buffer))))
- (haskell-interactive-mode-echo
- (haskell-process-session process)
- msg)
- (haskell-mode-message-line msg)))))
-
-(defun haskell-process-echo-load-message (process buffer echo-in-repl th)
- "Echo a load message."
- (let ((session (haskell-process-session process))
- (module-name (match-string 3 buffer))
- (file-name (match-string 4 buffer)))
- (haskell-interactive-show-load-message
- session
- 'compiling
- module-name
- (haskell-session-strip-dir session file-name)
- echo-in-repl
- th)))
-
-(defun haskell-process-errors-warnings (session process buffer)
- "Trigger handling type errors or warnings."
- (cond
- ((haskell-process-consume
- process
- "\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed")
- (let ((err (match-string 1 buffer)))
- (when (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err)
- (let* ((default-directory (haskell-session-current-dir session))
- (module (match-string 1 err))
- (file (match-string 2 err))
- (relative-file-name (file-relative-name file)))
- (haskell-interactive-show-load-message
- session
- 'import-cycle
- module
- relative-file-name
- nil
- nil)
- (haskell-interactive-mode-compile-error
- session
- (format "%s:1:0: %s"
- relative-file-name
- err)))))
- t)
- ((haskell-process-consume
- process
- (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):"
- "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]"))
- (haskell-process-set-response-cursor process
- (- (haskell-process-response-cursor process) 1))
- (let* ((buffer (haskell-process-response process))
- (file (match-string 1 buffer))
- (location (match-string 2 buffer))
- (error-msg (match-string 3 buffer))
- (warning (string-match "^Warning:" error-msg))
- (splice (string-match "^Splicing " error-msg))
- (final-msg (format "%s:%s: %s"
- (haskell-session-strip-dir session file)
- location
- error-msg)))
- (funcall (cond (warning
- 'haskell-interactive-mode-compile-warning)
- (splice
- 'haskell-interactive-mode-compile-splice)
- (t 'haskell-interactive-mode-compile-error))
- session final-msg)
- (unless warning
- (haskell-mode-message-line final-msg))
- (haskell-process-trigger-suggestions
- session
- error-msg
- file
- (plist-get (haskell-process-parse-error final-msg) :line)))
- t)))
-
-(defun haskell-process-parse-error (string)
- "Parse the line number from the error."
- (let ((span nil))
- (cl-loop for regex
- in haskell-compilation-error-regexp-alist
- do (when (string-match (car regex) string)
- (setq span
- (list :file (match-string 1 string)
- :line (string-to-number (match-string 2 string))
- :col (string-to-number (match-string 4 string))
- :line2 (when (match-string 3 string)
- (string-to-number (match-string 3 string)))
- :col2 (when (match-string 5 string)
- (string-to-number (match-string 5 string)))))))
- span))
-
-(defun haskell-process-trigger-suggestions (session msg file line)
- "Trigger prompting to add any extension suggestions."
- (cond ((let ((case-fold-search nil))
- (or (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg)
- (not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg)))
- (string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg)
- (string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg)
- (string-match "use \\([A-Z][A-Za-z]+\\)" msg)
- (string-match "You need \\([A-Z][A-Za-z]+\\)" msg)))
- (when haskell-process-suggest-language-pragmas
- (haskell-process-suggest-pragma session "LANGUAGE" (match-string 1 msg) file)))
- ((string-match " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant" msg)
- (when haskell-process-suggest-remove-import-lines
- (haskell-process-suggest-remove-import session
- file
- (match-string 2 msg)
- line)))
- ((string-match "Warning: orphan instance: " msg)
- (when haskell-process-suggest-no-warn-orphans
- (haskell-process-suggest-pragma session "OPTIONS" "-fno-warn-orphans" file)))
- ((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg)
- (string-match "with actual type [‘`‛]\\[Char\\]['’]" msg))
- (when haskell-process-suggest-overloaded-strings
- (haskell-process-suggest-pragma session "LANGUAGE" "OverloadedStrings" file)))
- ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg)
- (let* ((match1 (match-string 1 msg))
- (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1)
- ;; Skip qualification.
- (match-string 1 match1)
- match1)))
- (when haskell-process-suggest-hoogle-imports
- (let ((modules (haskell-process-hoogle-ident ident)))
- (haskell-process-suggest-imports session file modules ident)))
- (when haskell-process-suggest-haskell-docs-imports
- (let ((modules (haskell-process-haskell-docs-ident ident)))
- (haskell-process-suggest-imports session file modules ident)))
- (when haskell-process-suggest-hayoo-imports
- (let ((modules (haskell-process-hayoo-ident ident)))
- (haskell-process-suggest-imports session file modules ident)))))
- ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\(.+\\)['’].$" msg)
- (when haskell-process-suggest-add-package
- (haskell-process-suggest-add-package session msg)))))
-
-(defun haskell-process-suggest-add-package (session msg)
- "Add the (matched) module to your cabal file."
- (let* ((suggested-package (match-string 1 msg))
- (package-name (replace-regexp-in-string "-[^-]+$" "" suggested-package))
- (version (progn (string-match "\\([^-]+\\)$" suggested-package)
- (match-string 1 suggested-package)))
- (cabal-file (concat (haskell-session-name session)
- ".cabal")))
- (when (y-or-n-p
- (format "Add `%s' to %s?"
- package-name
- cabal-file))
- (haskell-cabal-add-dependency package-name version nil t))))
-
-(defun haskell-process-suggest-imports (session file modules ident)
- "Given a list of MODULES, suggest adding them to the import section."
- (cl-assert session)
- (cl-assert file)
- (cl-assert ident)
- (let* ((process (haskell-session-process session))
- (suggested-already (haskell-process-suggested-imports process))
- (module (cond ((> (length modules) 1)
- (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?"
- ident))
- (haskell-complete-module-read "Module: " modules)))
- ((= (length modules) 1)
- (let ((module (car modules)))
- (unless (member module suggested-already)
- (haskell-process-set-suggested-imports process (cons module suggested-already))
- (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?"
- ident
- module))
- module)))))))
- (when module
- (haskell-process-find-file session file)
- (save-excursion
- (goto-char (point-max))
- (haskell-navigate-imports)
- (insert (read-from-minibuffer "Import line: " (concat "import " module))
- "\n")
- (haskell-sort-imports)
- (haskell-align-imports)))))
-
-(defun haskell-process-haskell-docs-ident (ident)
- "Search with haskell-docs for IDENT, returns a list of modules."
- (cl-remove-if-not (lambda (a) (string-match "^[A-Z][A-Za-b0-9_'.]+$" a))
- (split-string (shell-command-to-string (concat "haskell-docs --modules " ident))
- "\n")))
-
-(defun haskell-process-hoogle-ident (ident)
- "Hoogle for IDENT, returns a list of modules."
- (with-temp-buffer
- (let ((hoogle-error (call-process "hoogle" nil t nil "search" "--exact" ident)))
- (goto-char (point-min))
- (unless (or (/= 0 hoogle-error)
- (looking-at "^No results found")
- (looking-at "^package "))
- (while (re-search-forward "^\\([^ ]+\\).*$" nil t)
- (replace-match "\\1" nil nil))
- (cl-remove-if (lambda (a) (string= "" a))
- (split-string (buffer-string)
- "\n"))))))
-
-(defvar url-http-response-status)
-(defvar url-http-end-of-headers)
-
-(defun haskell-process-hayoo-ident (ident)
- "Hayoo for IDENT, returns a list of modules asyncronously through CALLBACK."
- ;; We need a real/simulated closure, because otherwise these
- ;; variables will be unbound when the url-retrieve callback is
- ;; called.
- ;; TODO: Remove when this code is converted to lexical bindings by
- ;; default (Emacs 24.1+)
- (let ((url (format haskell-process-hayoo-query-url (url-hexify-string ident))))
- (with-current-buffer (url-retrieve-synchronously url)
- (if (= 200 url-http-response-status)
- (progn
- (goto-char url-http-end-of-headers)
- (let* ((res (json-read))
- (results (assoc-default 'result res)))
- ;; TODO: gather packages as well, and when we choose a
- ;; given import, check that we have the package in the
- ;; cabal file as well.
- (cl-mapcan (lambda (r)
- ;; append converts from vector -> list
- (append (assoc-default 'resultModules r) nil))
- results)))
- (warn "HTTP error %s fetching %s" url-http-response-status url)))))
-
-(defun haskell-process-suggest-remove-import (session file import line)
- "Suggest removing or commenting out IMPORT on LINE."
- (let ((continue t)
- (first t))
- (cl-case (read-event
- (propertize (format "%sThe import line `%s' is redundant. Remove? (y, n, c: comment out) "
- (if (not first)
- "Please answer n, y or c: "
- "")
- import)
- 'face 'minibuffer-prompt))
- (?y
- (haskell-process-find-file session file)
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (goto-char (line-beginning-position))
- (delete-region (line-beginning-position)
- (line-end-position))))
- (?n
- (message "Ignoring redundant import %s" import))
- (?c
- (haskell-process-find-file session file)
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (goto-char (line-beginning-position))
- (insert "-- "))))))
-
-(defun haskell-process-suggest-pragma (session pragma extension file)
- "Suggest to add something to the top of the file."
- (let ((string (format "{-# %s %s #-}" pragma extension)))
- (when (y-or-n-p (format "Add %s to the top of the file? " string))
- (haskell-process-find-file session file)
- (save-excursion
- (goto-char (point-min))
- (insert (concat string "\n"))))))
-
-(defun haskell-process-find-file (session file)
- "Find the given file in the project."
- (find-file (cond ((file-exists-p (concat (haskell-session-current-dir session) "/" file))
- (concat (haskell-session-current-dir session) "/" file))
- ((file-exists-p (concat (haskell-session-cabal-dir session) "/" file))
- (concat (haskell-session-cabal-dir session) "/" file))
- (t file))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Building the process
-;;;###autoload
-(defun haskell-process-start (session)
- "Start the inferior Haskell process."
- (let ((existing-process (get-process (haskell-session-name (haskell-session)))))
- (when (processp existing-process)
- (haskell-interactive-mode-echo session "Restarting process ...")
- (haskell-process-set (haskell-session-process session) 'is-restarting t)
- (delete-process existing-process)))
- (let ((process (or (haskell-session-process session)
- (haskell-process-make (haskell-session-name session))))
- (old-queue (haskell-process-get (haskell-session-process session)
- 'command-queue)))
- (haskell-session-set-process session process)
- (haskell-process-set-session process session)
- (haskell-process-set-cmd process nil)
- (haskell-process-set (haskell-session-process session) 'is-restarting nil)
- (let ((default-directory (haskell-session-cabal-dir session)))
- (haskell-session-pwd session)
- (haskell-process-set-process
- process
- (cl-ecase (haskell-process-type)
- ('ghci
- (haskell-process-log
- (propertize (format "Starting inferior GHCi process %s ..."
- haskell-process-path-ghci)
- 'face font-lock-comment-face))
- (apply #'start-process
- (append (list (haskell-session-name session)
- nil
- haskell-process-path-ghci)
- haskell-process-args-ghci)))
- ('cabal-repl
- (haskell-process-log
- (propertize
- (format "Starting inferior `cabal repl' process using %s ..."
- haskell-process-path-cabal)
- 'face font-lock-comment-face))
-
- (apply #'start-process
- (append (list (haskell-session-name session)
- nil
- haskell-process-path-cabal)
- '("repl") haskell-process-args-cabal-repl
- (let ((target (haskell-session-target session)))
- (if target (list target) nil)))))
- ('cabal-ghci
- (haskell-process-log
- (propertize
- (format "Starting inferior cabal-ghci process using %s ..."
- haskell-process-path-cabal-ghci)
- 'face font-lock-comment-face))
- (start-process (haskell-session-name session)
- nil
- haskell-process-path-cabal-ghci))
- ('cabal-dev
- (let ((dir (concat (haskell-session-cabal-dir session)
- "/cabal-dev")))
- (haskell-process-log
- (propertize (format "Starting inferior cabal-dev process %s -s %s ..."
- haskell-process-path-cabal-dev
- dir)
- 'face font-lock-comment-face))
- (start-process (haskell-session-name session)
- nil
- haskell-process-path-cabal-dev
- "ghci"
- "-s"
- dir))))))
- (progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel)
- (set-process-filter (haskell-process-process process) 'haskell-process-filter))
- (haskell-process-send-startup process)
- (unless (eq 'cabal-repl (haskell-process-type)) ;; "cabal repl" sets the proper CWD
- (haskell-process-change-dir session
- process
- (haskell-session-current-dir session)))
- (haskell-process-set process 'command-queue
- (append (haskell-process-get (haskell-session-process session)
- 'command-queue)
- old-queue))
- process))
-
-(defun haskell-process-clear ()
- "Clear the current process."
- (interactive)
- (haskell-process-reset (haskell-process))
- (haskell-process-set (haskell-process) 'command-queue nil))
-
-(defun haskell-process-restart ()
- "Restart the inferior Haskell process."
- (interactive)
- (haskell-process-reset (haskell-process))
- (haskell-process-set (haskell-process) 'command-queue nil)
- (haskell-process-start (haskell-session)))
-
-(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))))
-
(defun haskell-process-make (name)
"Make an inferior Haskell process."
(list (cons 'name name)))
-;;;###autoload
-(defun haskell-process ()
- "Get the current process from the current session."
- (haskell-session-process (haskell-session)))
-
-(defun haskell-process-interrupt ()
- "Interrupt the process (SIGINT)."
- (interactive)
- (interrupt-process (haskell-process-process (haskell-process))))
-
-(defun haskell-process-cd (&optional not-interactive)
- "Change directory."
- (interactive)
- (let* ((session (haskell-session))
- (dir (haskell-session-pwd session t)))
- (haskell-process-log
- (propertize (format "Changing directory to %s ...\n" dir)
- 'face font-lock-comment-face))
- (haskell-process-change-dir session
- (haskell-process)
- dir)))
-
-(defun haskell-session-pwd (session &optional change)
- "Prompt for the current directory."
- (or (unless change
- (haskell-session-get session 'current-dir))
- (progn (haskell-session-set-current-dir
- session
- (haskell-utils-read-directory-name
- (if change "Change directory: " "Set current directory: ")
- (or (haskell-session-get session 'current-dir)
- (haskell-session-get session 'cabal-dir)
- (if (buffer-file-name)
- (file-name-directory (buffer-file-name))
- "~/"))))
- (haskell-session-get session 'current-dir))))
-
-(defun haskell-process-change-dir (session process dir)
- "Change the directory of the current process."
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list session process dir)
-
- :go
- (lambda (state)
- (haskell-process-send-string
- (cadr state) (format ":cd %s" (cl-caddr state))))
-
- :complete
- (lambda (state _)
- (haskell-session-set-current-dir (car state) (cl-caddr state))
- (haskell-interactive-mode-echo (car state)
- (format "Changed directory: %s"
- (cl-caddr state)))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Process communication
-(defun haskell-process-send-startup (process)
- "Send the necessary start messages."
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state process
-
- :go (lambda (process)
- (haskell-process-send-string process ":set prompt \"\\4\"")
- (haskell-process-send-string process "Prelude.putStrLn \"\"")
- (haskell-process-send-string process ":set -v1"))
-
- :live (lambda (process buffer)
- (when (haskell-process-consume
- process
- "^\*\*\* WARNING: \\(.+\\) is writable by someone else, IGNORING!$")
- (let ((path (match-string 1 buffer)))
- (haskell-session-modify
- (haskell-process-session process)
- 'ignored-files
- (lambda (files)
- (cl-remove-duplicates (cons path files) :test 'string=)))
- (haskell-interactive-mode-compile-warning
- (haskell-process-session process)
- (format "GHCi is ignoring: %s (run M-x haskell-process-unignore)"
- path)))))
-
- :complete (lambda (process _)
- (haskell-interactive-mode-echo
- (haskell-process-session process)
- (concat (nth (random (length haskell-process-greetings))
- haskell-process-greetings)
- (when haskell-process-show-debug-tips
- "
-If I break, you can:
- 1. Restart: M-x haskell-process-restart
- 2. Configure logging: C-h v haskell-process-log (useful for debugging)
- 3. General config: M-x customize-mode
- 4. Hide these tips: C-h v haskell-process-show-debug-tips")))))))
-
(defun haskell-process-sentinel (proc event)
"The sentinel for the process pipe."
(let ((session (haskell-process-project-by-proc proc)))
@@ -1229,7 +89,7 @@ If I break, you can:
(haskell-process-log
(propertize "Process reset.\n"
'face font-lock-comment-face))
- (haskell-process-prompt-restart process))))))
+ (run-hook-with-args 'haskell-process-ended-hook process))))))
(defun haskell-process-filter (proc response)
"The filter for the process pipe."
@@ -1247,8 +107,7 @@ If I break, you can:
(haskell-process-collect session
response
(haskell-session-process session))
- (haskell-interactive-mode-insert-garbage
- session
+ (haskell-process-log
(replace-regexp-in-string "\4" "" response))))))
(defun haskell-process-log (msg)
@@ -1306,26 +165,7 @@ If I break, you can:
'face '((:weight bold))))
(process-send-string child out))
(unless (haskell-process-restarting process)
- (haskell-process-prompt-restart process)))))
-
-(defun haskell-process-prompt-restart (process)
- "Prompt to restart the died process."
- (let ((process-name (haskell-process-name process)))
- (if haskell-process-suggest-restart
- (cl-case (read-event
- (propertize (format "The Haskell process `%s' has died. Restart? (y, n, l: show process log)"
- process-name)
- 'face 'minibuffer-prompt))
- (?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))
- (message (format "The Haskell process `%s' is dearly departed."
- process-name)))))
+ (run-hook-with-args 'haskell-process-ended process)))))
(defun haskell-process-live-updates (process)
"Process live updates."
@@ -1361,8 +201,8 @@ the response."
(haskell-process-set-cmd process cmd)
(haskell-command-exec-go cmd))))
(progn (haskell-process-reset process)
- (haskell-process-set (haskell-process) 'command-queue nil)
- (haskell-process-prompt-restart process))))
+ (haskell-process-set process 'command-queue nil)
+ (run-hook-with-args 'haskell-process-ended process))))
(defun haskell-process-queue-flushed-p (process)
"Return t if command queue has been completely processed."
@@ -1528,71 +368,6 @@ Returns nil if queue is empty."
(haskell-process-set process 'command-queue (cdr queue))
(car queue))))
-(defun haskell-process-unignore ()
- "Unignore any files that were specified as being ignored by the
- inferior GHCi process."
- (interactive)
- (let ((session (haskell-session))
- (changed nil))
- (if (null (haskell-session-get session
- 'ignored-files))
- (message "Nothing to unignore!")
- (cl-loop for file in (haskell-session-get session
- 'ignored-files)
- do (cl-case (read-event
- (propertize (format "Set permissions? %s (y, n, v: stop and view file)"
- file)
- 'face 'minibuffer-prompt))
- (?y
- (haskell-process-unignore-file session file)
- (setq changed t))
- (?v
- (find-file file)
- (cl-return))))
- (when (and changed
- (y-or-n-p "Restart GHCi process now? "))
- (haskell-process-restart)))))
-
-(defun haskell-process-reload-devel-main ()
- "Reload the module `DevelMain' and then run
-`DevelMain.update'. This is for doing live update of the code of
-servers or GUI applications. Put your development version of the
-program in `DevelMain', and define `update' to auto-start the
-program on a new thread, and use the `foreign-store' package to
-access the running context across :load/:reloads in GHCi."
- (interactive)
- (with-current-buffer (or (get-buffer "DevelMain.hs")
- (if (y-or-n-p "You need to open a buffer named DevelMain.hs. Find now?")
- (ido-find-file)
- (error "No DevelMain.hs buffer.")))
- (let ((session (haskell-session)))
- (let ((process (haskell-process)))
- (haskell-process-queue-command
- process
- (make-haskell-command
- :state (list :session session
- :process process
- :buffer (current-buffer))
- :go (lambda (state)
- (haskell-process-send-string (plist-get state ':process)
- ":l DevelMain"))
- :live (lambda (state buffer)
- (haskell-process-live-build (plist-get state ':process)
- buffer
- nil))
- :complete (lambda (state response)
- (haskell-process-load-complete
- (plist-get state ':session)
- (plist-get state ':process)
- response
- nil
- (plist-get state ':buffer)
- (lambda (ok)
- (when ok
- (haskell-process-queue-without-filters
- (haskell-process)
- "DevelMain.update")
- (message "DevelMain updated.")))))))))))
(defun haskell-process-unignore-file (session file)
"
@@ -1615,7 +390,7 @@ function and remove this comment.
(concat "chmod 700 "
file)))
(haskell-session-modify
- (haskell-session)
+ session
'ignored-files
(lambda (files)
(cl-remove-if (lambda (path)
@@ -1647,31 +422,6 @@ function and remove this comment.
(haskell-command-state command)
response))))
-(defun haskell-process-cabal-macros ()
- "Send the cabal macros string."
- (interactive)
- (haskell-process-queue-without-filters (haskell-process)
- ":set -optP-include -optPdist/build/autogen/cabal_macros.h"))
-
-(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)
- ".imports")))
-
(defvar interactive-haskell-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-l") 'haskell-process-load-or-reload)
diff --git a/haskell-repl.el b/haskell-repl.el
new file mode 100644
index 000000000..e057100c5
--- /dev/null
+++ b/haskell-repl.el
@@ -0,0 +1,117 @@
+;;; haskell-repl.el --- REPL evaluation
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; 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 .
+
+;;; Code:
+
+(require 'haskell-interactive-mode)
+
+(defun haskell-interactive-handle-expr ()
+ "Handle an inputted expression at the REPL."
+ (when (haskell-interactive-at-prompt)
+ (let ((expr (haskell-interactive-mode-input)))
+ (unless (string= "" (replace-regexp-in-string " " "" expr))
+ (cond
+ ;; If already evaluating, then the user is trying to send
+ ;; input to the REPL during evaluation. Most likely in
+ ;; response to a getLine-like function.
+ ((and (haskell-process-evaluating-p (haskell-interactive-process))
+ (= (line-end-position) (point-max)))
+ (goto-char (point-max))
+ (let ((process (haskell-interactive-process))
+ (string (buffer-substring-no-properties
+ haskell-interactive-mode-result-end
+ (point))))
+ (insert "\n")
+ ;; Bring the marker forward
+ (setq haskell-interactive-mode-result-end
+ (point-max))
+ (haskell-process-set-sent-stdin process t)
+ (haskell-process-send-string process string)))
+ ;; Otherwise we start a normal evaluation call.
+ (t (setq haskell-interactive-mode-old-prompt-start
+ (copy-marker haskell-interactive-mode-prompt-start))
+ (set-marker haskell-interactive-mode-prompt-start (point-max))
+ (haskell-interactive-mode-history-add expr)
+ (haskell-interactive-mode-do-expr expr)))))))
+
+(defun haskell-interactive-mode-do-expr (expr)
+ (cond
+ ((string-match "^:present " expr)
+ (haskell-interactive-mode-do-presentation (replace-regexp-in-string "^:present " "" expr)))
+ (t
+ (haskell-interactive-mode-run-expr expr))))
+
+(defun haskell-interactive-mode-run-expr (expr)
+ "Run the given expression."
+ (let ((session (haskell-interactive-session))
+ (process (haskell-interactive-process))
+ (lines (length (split-string expr "\n"))))
+ (haskell-process-queue-command
+ process
+ (make-haskell-command
+ :state (list session process expr 0)
+ :go (lambda (state)
+ (goto-char (point-max))
+ (insert "\n")
+ (setq haskell-interactive-mode-result-end
+ (point-max))
+ (haskell-process-send-string (cadr state)
+ (haskell-interactive-mode-multi-line (cl-caddr state)))
+ (haskell-process-set-evaluating (cadr state) t))
+ :live (lambda (state buffer)
+ (unless (and (string-prefix-p ":q" (cl-caddr state))
+ (string-prefix-p (cl-caddr state) ":quit"))
+ (let* ((cursor (cl-cadddr state))
+ (next (replace-regexp-in-string
+ haskell-process-prompt-regex
+ ""
+ (substring buffer cursor))))
+ (haskell-interactive-mode-eval-result (car state) next)
+ (setf (cl-cdddr state) (list (length buffer)))
+ nil)))
+ :complete
+ (lambda (state response)
+ (haskell-process-set-evaluating (cadr state) nil)
+ (unless (haskell-interactive-mode-trigger-compile-error state response)
+ (haskell-interactive-mode-expr-result state response)))))))
+
+(defun haskell-interactive-mode-expr-result (state response)
+ "Print the result of evaluating the expression."
+ (let ((response
+ (with-temp-buffer
+ (insert (haskell-interactive-mode-cleanup-response
+ (cl-caddr state) response))
+ (haskell-interactive-mode-handle-h (point-min))
+ (buffer-string))))
+ (when haskell-interactive-mode-eval-mode
+ (unless (haskell-process-sent-stdin-p (cadr state))
+ (haskell-interactive-mode-eval-as-mode (car state) response))))
+ (haskell-interactive-mode-prompt (car state)))
+
+(defun haskell-interactive-mode-eval-as-mode (session text)
+ "Insert TEXT font-locked according to `haskell-interactive-mode-eval-mode'."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (let ((inhibit-read-only t))
+ (delete-region (1+ haskell-interactive-mode-prompt-start) (point))
+ (goto-char (point-max))
+ (let ((start (point)))
+ (insert (haskell-fontify-as-mode text
+ haskell-interactive-mode-eval-mode))
+ (when haskell-interactive-mode-collapse
+ (haskell-collapse start (point)))))))
+
+(provide 'haskell-repl)
diff --git a/haskell-session.el b/haskell-session.el
index 5bb117caf..0d85ac2c8 100644
--- a/haskell-session.el
+++ b/haskell-session.el
@@ -27,29 +27,17 @@
;;; Code:
-(require 'cl-lib)
(require 'haskell-cabal)
(require 'haskell-string)
-(require 'haskell-mode)
-
-(declare-function haskell-interactive-mode "haskell-interactive-mode" ())
-(declare-function haskell-kill-session-process "haskell-process" (&optional session))
-(declare-function haskell-process-start "haskell-process" (session))
-(declare-function haskell-process-cd "haskell-process" (&optional not-interactive))
-(declare-function haskell-process-type "haskell-process" ())
+(require 'haskell-customize)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Configuration
+;; Globals
-(defcustom haskell-ask-also-kill-buffers
- t
- "Ask whether to kill all associated buffers when a session
- process is killed."
- :type 'boolean
- :group 'haskell-interactive)
+;; Used internally
+(defvar haskell-session)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Globals
+(make-variable-buffer-local 'haskell-session)
(defvar haskell-sessions (list)
"All Haskell sessions in the Emacs session.")
@@ -58,96 +46,9 @@
"Get the filename for the TAGS file."
(concat (haskell-session-cabal-dir session) "/TAGS"))
-;;;###autoload
-(defun haskell-session-all-modules (&optional dontcreate)
- "Get all modules -- installed or in the current project.
-If DONTCREATE is non-nil don't create a new session."
- (append (haskell-session-installed-modules dontcreate)
- (haskell-session-project-modules dontcreate)))
-
-;;;###autoload
-(defun haskell-session-installed-modules (&optional dontcreate)
- "Get the modules installed in the current package set.
-If DONTCREATE is non-nil don't create a new session."
- ;; TODO: Again, this makes HEAVY use of unix utilities. It'll work
- ;; fine in Linux, probably okay on OS X, and probably not at all on
- ;; Windows. Again, if someone wants to test on Windows and come up
- ;; with alternatives that's OK.
- ;;
- ;; Ideally all these package queries can be provided by a Haskell
- ;; program based on the Cabal API. Possibly as a nice service. Such
- ;; a service could cache and do nice things like that. For now, this
- ;; simple shell script takes us far.
- ;;
- ;; Probably also we can take the code from inferior-haskell-mode.
- ;;
- ;; Ugliness aside, if it saves us time to type it's a winner.
- ;;
- ;; FIXME/TODO: add support for (eq 'cabal-repl (haskell-process-type))
- (let ((modules (shell-command-to-string
- (format "%s | %s | %s"
- (if (eq 'cabal-dev (haskell-process-type))
- (if (or (not dontcreate) (haskell-session-maybe))
- (format "cabal-dev -s %s/cabal-dev ghc-pkg dump"
- (haskell-session-cabal-dir (haskell-session)))
- "echo ''")
- "ghc-pkg dump")
- "egrep '^(exposed-modules: | )[A-Z]'"
- "cut -c18-"))))
- (split-string modules)))
-
-(defun haskell-session-project-modules (&optional dontcreate)
- "Get the modules of the current project.
-If DONTCREATE is non-nil don't create a new session."
- (if (or (not dontcreate) (haskell-session-maybe))
- (let* ((session (haskell-session))
- (modules
- (shell-command-to-string
- (format "%s && %s"
- (format "cd %s" (haskell-session-cabal-dir session))
- ;; TODO: Use a different, better source. Possibly hasktags or some such.
- ;; TODO: At least make it cross-platform. Linux
- ;; (and possibly OS X) have egrep, Windows
- ;; doesn't -- or does it via Cygwin or MinGW?
- ;; This also doesn't handle module\nName. But those gits can just cut it out!
- "egrep '^module[\t\r ]+[^(\t\r ]+' . -r -I --include='*.*hs' --include='*.hsc' -s -o -h | sed 's/^module[\t\r ]*//' | sort | uniq"))))
- (split-string modules))))
-
-(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.
-3. Walk through all the related buffers and set their haskell-session to nil.
-4. Remove the session from the sessions list."
- (interactive)
- (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))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Finding/clearing the session
-;; Used internally
-(defvar haskell-session)
-
;;;###autoload
(defun haskell-session-maybe ()
"Maybe get the Haskell session, return nil if there isn't one."
@@ -155,24 +56,6 @@ If DONTCREATE is non-nil don't create a new session."
haskell-session
(setq haskell-session nil)))
-;;;###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)))))
-
-(defun haskell-session-new-assume-from-cabal ()
- "Prompt to create a new project based on a guess from the nearest Cabal file."
- (let ((name (haskell-session-default-name)))
- (unless (haskell-session-lookup name)
- (when (y-or-n-p (format "Start a new project named “%s”? "
- name))
- (haskell-session-make name)))))
-
(defun haskell-session-from-buffer ()
"Get the session based on the buffer."
(when (and (buffer-file-name)
@@ -194,16 +77,6 @@ If DONTCREATE is non-nil don't create a new session."
haskell-sessions
:initial-value nil)))
-(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)))
- (if session
- (when (y-or-n-p (format "Session %s already exists. Use it?" name))
- session)
- (haskell-session-make name))))))
-
(defun haskell-session-default-name ()
"Generate a default project name for the new project prompt."
(let ((file (haskell-cabal-find-file)))
@@ -236,23 +109,69 @@ If DONTCREATE is non-nil don't create a new session."
"Clear the buffer of any Haskell session choice."
(set (make-local-variable 'haskell-session) nil))
-(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-session-change-target (target)
- "Set the build target for cabal repl"
- (interactive "sNew build target:")
- (let* ((session haskell-session)
- (old-target (haskell-session-get session 'target)))
- (when session
- (haskell-session-set-target session target)
- (when (and (not (string= old-target target))
- (y-or-n-p "Target changed, restart haskell process?"))
- (haskell-process-start session)))))
+(defun haskell-session-lookup (name)
+ "Get the session by name."
+ (cl-remove-if-not (lambda (s)
+ (string= name (haskell-session-name s)))
+ haskell-sessions))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Session modules
+
+;;;###autoload
+(defun haskell-session-installed-modules (session &optional dontcreate)
+ "Get the modules installed in the current package set.
+If DONTCREATE is non-nil don't create a new session."
+ ;; TODO: Again, this makes HEAVY use of unix utilities. It'll work
+ ;; fine in Linux, probably okay on OS X, and probably not at all on
+ ;; Windows. Again, if someone wants to test on Windows and come up
+ ;; with alternatives that's OK.
+ ;;
+ ;; Ideally all these package queries can be provided by a Haskell
+ ;; program based on the Cabal API. Possibly as a nice service. Such
+ ;; a service could cache and do nice things like that. For now, this
+ ;; simple shell script takes us far.
+ ;;
+ ;; Probably also we can take the code from inferior-haskell-mode.
+ ;;
+ ;; Ugliness aside, if it saves us time to type it's a winner.
+ ;;
+ ;; FIXME/TODO: add support for (eq 'cabal-repl (haskell-process-type))
+ (let ((modules (shell-command-to-string
+ (format "%s | %s | %s"
+ (if (eq 'cabal-dev (haskell-process-type))
+ (if (or (not dontcreate) (haskell-session-maybe))
+ (format "cabal-dev -s %s/cabal-dev ghc-pkg dump"
+ (haskell-session-cabal-dir session))
+ "echo ''")
+ "ghc-pkg dump")
+ "egrep '^(exposed-modules: | )[A-Z]'"
+ "cut -c18-"))))
+ (split-string modules)))
+
+;;;###autoload
+(defun haskell-session-all-modules (session &optional dontcreate)
+ "Get all modules -- installed or in the current project.
+If DONTCREATE is non-nil don't create a new session."
+ (append (haskell-session-installed-modules session dontcreate)
+ (haskell-session-project-modules session dontcreate)))
+
+;;;###autoload
+(defun haskell-session-project-modules (session &optional dontcreate)
+ "Get the modules of the current project.
+If DONTCREATE is non-nil don't create a new session."
+ (if (or (not dontcreate) (haskell-session-maybe))
+ (let* ((modules
+ (shell-command-to-string
+ (format "%s && %s"
+ (format "cd %s" (haskell-session-cabal-dir session))
+ ;; TODO: Use a different, better source. Possibly hasktags or some such.
+ ;; TODO: At least make it cross-platform. Linux
+ ;; (and possibly OS X) have egrep, Windows
+ ;; doesn't -- or does it via Cygwin or MinGW?
+ ;; This also doesn't handle module\nName. But those gits can just cut it out!
+ "egrep '^module[\t\r ]+[^(\t\r ]+' . -r -I --include='*.*hs' --include='*.hsc' -s -o -h | sed 's/^module[\t\r ]*//' | sort | uniq"))))
+ (split-string modules))))
(defun haskell-session-strip-dir (session file)
"Strip the load dir from the file path."
@@ -267,28 +186,15 @@ If DONTCREATE is non-nil don't create a new session."
file)
file)))
-(defun haskell-session-lookup (name)
- "Get the session by name."
- (cl-remove-if-not (lambda (s)
- (string= name (haskell-session-name s)))
- haskell-sessions))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Building the session
-
-(defun haskell-session-make (name)
- "Make a Haskell session."
- (when (haskell-session-lookup name)
- (error "Session of name %s already exists!" name))
- (let ((session (set (make-local-variable 'haskell-session)
- (list (cons 'name name)))))
- (add-to-list 'haskell-sessions session)
- (haskell-process-start session)
- session))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Accessing the session
+(defun haskell-session-current-dir (s)
+ "Get the session current directory."
+ (let ((dir (haskell-session-get s 'current-dir)))
+ (or dir
+ (error "No current directory."))))
+
(defun haskell-session-name (s)
"Get the session name."
(haskell-session-get s 'name))
@@ -306,19 +212,6 @@ If DONTCREATE is non-nil don't create a new session."
"Set the session build target."
(haskell-session-set s 'target target))
-(defun haskell-session-interactive-buffer (s)
- "Get the session interactive buffer."
- (let ((buffer (haskell-session-get s 'interactive-buffer)))
- (if (and buffer (buffer-live-p buffer))
- buffer
- (let ((buffer (get-buffer-create (format "*%s*" (haskell-session-name s)))))
- (haskell-session-set-interactive-buffer s buffer)
- (with-current-buffer buffer
- (haskell-interactive-mode)
- (haskell-session-assign s))
- (switch-to-buffer-other-window buffer)
- buffer))))
-
(defun haskell-session-set-interactive-buffer (s v)
"Set the session interactive buffer."
(haskell-session-set s 'interactive-buffer v))
@@ -348,12 +241,6 @@ If DONTCREATE is non-nil don't create a new session."
(haskell-session-set s 'cabal-checksum
(haskell-cabal-compute-checksum cabal-dir)))
-(defun haskell-session-current-dir (s)
- "Get the session current directory."
- (let ((dir (haskell-session-get s 'current-dir)))
- (or dir
- (haskell-process-cd t))))
-
(defun haskell-session-cabal-dir (s &optional no-prompt)
"Get the session cabal-dir."
(let ((dir (haskell-session-get s 'cabal-dir)))
diff --git a/haskell.el b/haskell.el
new file mode 100644
index 000000000..b29c46c02
--- /dev/null
+++ b/haskell.el
@@ -0,0 +1,391 @@
+;;; haskell.el --- Top-level Haskell package
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; 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 .
+
+;;; Code:
+
+(require 'haskell-mode)
+(require 'haskell-process)
+(require 'haskell-debug)
+(require 'haskell-interactive-mode)
+(require 'haskell-repl)
+(require 'haskell-load)
+(require 'haskell-commands)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Basic configuration hooks
+
+(add-hook 'haskell-process-ended-hook 'haskell-process-prompt-restart)
+(add-hook 'kill-buffer-hook 'haskell-interactive-kill)
+
+(defun haskell-interactive-mode-return ()
+ "Handle the return key."
+ (interactive)
+ (cond
+ ((haskell-interactive-at-compile-message)
+ (next-error-internal))
+ (t
+ (haskell-interactive-handle-expr))))
+
+(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.
+3. Walk through all the related buffers and set their haskell-session to nil.
+4. Remove the session from the sessions list."
+ (interactive)
+ (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))))
+
+(defun haskell-interactive-kill ()
+ "Kill the buffer and (maybe) the session."
+ (interactive)
+ (when (eq major-mode 'haskell-interactive-mode)
+ (when (and (boundp 'haskell-session)
+ haskell-session
+ (y-or-n-p "Kill the whole session?"))
+ (haskell-session-kill 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."
+ (let ((name (haskell-session-default-name)))
+ (unless (haskell-session-lookup name)
+ (when (y-or-n-p (format "Start a new project named “%s”? "
+ name))
+ (haskell-session-make name)))))
+
+;;;###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)))
+ (if session
+ (when (y-or-n-p (format "Session %s already exists. Use it?" name))
+ session)
+ (haskell-session-make name))))))
+
+;;;###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)))
+ (if haskell-process-suggest-restart
+ (cl-case (read-event
+ (propertize (format "The Haskell process `%s' has died. Restart? (y, n, l: show process log)"
+ process-name)
+ 'face 'minibuffer-prompt))
+ (?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))
+ (message (format "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)))
+
+(defun haskell-interactive-buffer ()
+ "Get the interactive buffer of the session."
+ (haskell-session-interactive-buffer (haskell-session)))
+
+(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))))
+
+(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)))))
+
+(defun haskell-mode-contextual-space ()
+ "Contextually do clever stuff when hitting space."
+ (interactive)
+ (if (or (not (bound-and-true-p interactive-haskell-mode))
+ (not (haskell-session-maybe)))
+ (self-insert-command 1)
+ (cond ((and haskell-mode-contextual-import-completion
+ (save-excursion (forward-word -1)
+ (looking-at "^import$")))
+ (insert " ")
+ (let ((module (haskell-complete-module-read
+ "Module: "
+ (haskell-session-all-modules (haskell-session)))))
+ (insert module)
+ (haskell-mode-format-imports)))
+ ((not (string= "" (save-excursion (forward-char -1) (haskell-ident-at-point))))
+ (let ((ident (save-excursion (forward-char -1) (haskell-ident-at-point))))
+ (insert " ")
+ (haskell-process-do-try-info ident)))
+ (t (insert " ")))))
+
+(defun haskell-mode-jump-to-tag (&optional next-p)
+ "Jump to the tag of the given identifier."
+ (interactive "P")
+ (let ((ident (haskell-ident-at-point))
+ (tags-file-name (haskell-session-tags-filename (haskell-session)))
+ (tags-revert-without-query t))
+ (when (not (string= "" (haskell-trim ident)))
+ (cond ((file-exists-p tags-file-name)
+ (find-tag ident next-p))
+ (t (haskell-process-generate-tags ident))))))
+
+(defun haskell-mode-after-save-handler ()
+ "Function that will be called after buffer's saving."
+ (when haskell-tags-on-save
+ (ignore-errors (when (and (boundp 'haskell-session) haskell-session)
+ (haskell-process-generate-tags))))
+ (when haskell-stylish-on-save
+ (ignore-errors (haskell-mode-stylish-buffer))
+ (let ((before-save-hook '())
+ (after-save-hook '()))
+ (basic-save-buffer))))
+
+(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)))
+ (unless (and (cl-find-if (lambda (window) (equal (window-buffer window) buffer))
+ (window-list))
+ (= 2 (length (window-list))))
+ (delete-other-windows)
+ (display-buffer buffer)
+ (other-window 1))))
+
+(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-file ()
+ "Re-load the current buffer file."
+ (interactive)
+ (save-buffer)
+ (haskell-interactive-mode-reset-error (haskell-session))
+ (haskell-process-file-loadish "reload" t nil))
+
+;;;###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 .")))
+ (if haskell-reload-p (haskell-process-reload-file) (haskell-process-load-file))))
+
+;;;###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)))))))))
+
+(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)
+ ".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)
diff --git a/w3m-haddock.el b/w3m-haddock.el
index 842723a87..7e6c99268 100644
--- a/w3m-haddock.el
+++ b/w3m-haddock.el
@@ -22,6 +22,9 @@
;; Boston, MA 02110-1301, USA.
(require 'cl-lib)
+(require 'haskell-mode)
+(require 'haskell-font-lock)
+
(declare-function w3m-buffer-title "w3m")
(declare-function w3m-browse-url "w3m")
(defvar w3m-current-url)