From 2c289a77b82812d7c9d29285ab8ab04610bd5899 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Sat, 17 Jan 2015 23:01:27 -0500 Subject: [PATCH 1/8] Get type information from ghci in interaction-mode See also #432, this makes haskell's eldoc support somewhat more complete and precise. --- haskell-doc.el | 71 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 69 insertions(+), 2 deletions(-) diff --git a/haskell-doc.el b/haskell-doc.el index 34a663fce..36a23f0db 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1,4 +1,4 @@ -;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8 -*- +;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. ;; Copyright (C) 1997 Hans-Wolfgang Loidl @@ -343,8 +343,11 @@ ;;@subsection Emacs portability (require 'haskell-mode) +(require 'haskell-process) +(require 'haskell) (require 'inf-haskell) (require 'imenu) +(require 'eldoc) (defgroup haskell-doc nil "Show Haskell function types in echo area." @@ -1519,7 +1522,12 @@ This function is run by an idle timer to print the type (defun haskell-doc-current-info () "Return the info about symbol at point. Meant for `eldoc-documentation-function'." - (haskell-doc-sym-doc (haskell-ident-at-point))) + ;; There are a number of possible documentation functions. + ;; Some of them are asynchronous. + (let ((msg (or + (haskell-doc-current-info--interaction) + (haskell-doc-sym-doc (haskell-ident-at-point))))) + (unless (symbolp msg) msg))) ;;@node Mouse interface, Print fctsym, Top level function, top @@ -1583,6 +1591,65 @@ current buffer." (let ((message-log-max nil)) (message "%s" doc))))))) +(defvar haskell-doc-current-info--interaction-last nil + "If non-nil, a previous eldoc message from an async call, that + hasn't been displayed yet.") + +(defun haskell-doc-current-info--interaction () + "Asynchronous call to `haskell-process-get-type', suitable for +use in the eldoc function `haskell-doc-current-info'." + ;; Return nil if nothing is available, or 'async if something might + ;; be available, but asynchronously later. This will call + ;; `eldoc-print-current-symbol-info' later. + (let (sym prev-message) + (cond + ((setq prev-message haskell-doc-current-info--interaction-last) + (setq haskell-doc-current-info--interaction-last nil) + (cdr prev-message)) + ((setq sym + (if (use-region-p) + (buffer-substring-no-properties + (region-beginning) (region-end)) + (thing-at-point 'symbol 'no-properties))) + (haskell-process-get-type + sym (lambda (response) + (setq haskell-doc-current-info--interaction-last + (cons 'async response)) + (eldoc-print-current-symbol-info))) + 'async)))) + +(defun haskell-process-get-type (expr-string &optional callback) + "Asynchronously get the type of a given string. + +EXPR-STRING should be an expression passed to :type in ghci. + +CALLBACK will be called with a formatted type string." + (let ((process (haskell-process)) + ;; Avoid passing bad strings to ghci + (expr-okay (not (string-match-p "\n" expr-string))) + (ghci-command (concat ":type " expr-string))) + (when (and process expr-okay) + (haskell-process-queue-command + (haskell-process) + (make-haskell-command + :go (lambda (_) (haskell-process-send-string process ghci-command)) + :complete + (lambda (_ response) + ;; Responses with empty first line are likely errors + (if (string-match-p (rx string-start line-end) response) + (setq response nil) + ;; Remove a newline at the end + (setq response (replace-regexp-in-string "\n\\'" "" response)) + ;; Propertize for eldoc + (save-match-data + (when (string-match " :: " response) + ;; Highlight type + (let ((name (substring response 0 (match-end 0))) + (type (propertize + (substring response (match-end 0)) + 'face 'eldoc-highlight-function-argument))) + (setq response (concat name type)))))) + (when callback (funcall callback response)))))))) (defun haskell-doc-sym-doc (sym) "Show the type of the function near point. From 17465674efc0acf1d21f840b338052ecb3683402 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Sat, 17 Jan 2015 23:03:54 -0500 Subject: [PATCH 2/8] Prettify Haskell types in eldoc support. Replaces some substrings like "::" with Unicode characters. --- haskell-customize.el | 7 +++++++ haskell-doc.el | 6 +++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/haskell-customize.el b/haskell-customize.el index 8f5df6a04..52ceed23e 100644 --- a/haskell-customize.el +++ b/haskell-customize.el @@ -77,6 +77,13 @@ a per-project basis." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Configuration +(defcustom haskell-doc-prettify-types t + "Replace some parts of types with Unicode characters like \"∷\" +when showing type information about symbols." + :group 'haskell-doc + :type 'boolean + :safe 'booleanp) + (defvar haskell-process-end-hook nil "Hook for when the haskell process ends.") diff --git a/haskell-doc.el b/haskell-doc.el index 36a23f0db..c47bc8ebf 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1648,7 +1648,11 @@ CALLBACK will be called with a formatted type string." (type (propertize (substring response (match-end 0)) 'face 'eldoc-highlight-function-argument))) - (setq response (concat name type)))))) + (setq response (concat name type))))) + (when haskell-doc-prettify-types + (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) + (setq response + (replace-regexp-in-string (car re) (cdr re) response))))) (when callback (funcall callback response)))))))) (defun haskell-doc-sym-doc (sym) From 954f183c8bb4cc301837b10a2199b5abac3409e4 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Sun, 18 Jan 2015 00:17:44 -0500 Subject: [PATCH 3/8] Synchronous type information with interaction mode haskell-doc-show-type should now show types of things not available in its precomputed docstring list, same as the eldoc function. --- haskell-doc.el | 89 +++++++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 38 deletions(-) diff --git a/haskell-doc.el b/haskell-doc.el index c47bc8ebf..a8ab52f85 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1578,7 +1578,8 @@ current buffer." (unless sym (setq sym (haskell-ident-at-point))) ;; if printed before do not print it again (unless (string= sym (car haskell-doc-last-data)) - (let ((doc (haskell-doc-sym-doc sym))) + (let ((doc (or (haskell-doc-current-info--interaction t) + (haskell-doc-sym-doc sym)))) (when (and doc (haskell-doc-in-code-p)) ;; In Emacs 19.29 and later, and XEmacs 19.13 and later, all ;; messages are recorded in a log. Do not put haskell-doc messages @@ -1595,9 +1596,13 @@ current buffer." "If non-nil, a previous eldoc message from an async call, that hasn't been displayed yet.") -(defun haskell-doc-current-info--interaction () +(defun haskell-doc-current-info--interaction (&optional sync) "Asynchronous call to `haskell-process-get-type', suitable for -use in the eldoc function `haskell-doc-current-info'." +use in the eldoc function `haskell-doc-current-info'. + +If SYNC is non-nil, the call will be synchronous instead, and +instead of calling `eldoc-print-current-symbol-info', the result +will be returned directly." ;; Return nil if nothing is available, or 'async if something might ;; be available, but asynchronously later. This will call ;; `eldoc-print-current-symbol-info' later. @@ -1611,49 +1616,57 @@ use in the eldoc function `haskell-doc-current-info'." (buffer-substring-no-properties (region-beginning) (region-end)) (thing-at-point 'symbol 'no-properties))) - (haskell-process-get-type - sym (lambda (response) - (setq haskell-doc-current-info--interaction-last - (cons 'async response)) - (eldoc-print-current-symbol-info))) - 'async)))) - -(defun haskell-process-get-type (expr-string &optional callback) + (if sync + (haskell-process-get-type sym #'identity t) + (haskell-process-get-type + sym (lambda (response) + (setq haskell-doc-current-info--interaction-last + (cons 'async response)) + (eldoc-print-current-symbol-info))) + 'async))))) + +(defun haskell-process-get-type (expr-string &optional callback sync) "Asynchronously get the type of a given string. EXPR-STRING should be an expression passed to :type in ghci. -CALLBACK will be called with a formatted type string." +CALLBACK will be called with a formatted type string. + +If SYNC is non-nil, make the call synchronously instead." (let ((process (haskell-process)) ;; Avoid passing bad strings to ghci (expr-okay (not (string-match-p "\n" expr-string))) - (ghci-command (concat ":type " expr-string))) + (ghci-command (concat ":type " expr-string)) + (complete-func + (lambda (_ response) + ;; Responses with empty first line are likely errors + (if (string-match-p (rx string-start line-end) response) + (setq response nil) + ;; Remove a newline at the end + (setq response (replace-regexp-in-string "\n\\'" "" response)) + ;; Propertize for eldoc + (save-match-data + (when (string-match " :: " response) + ;; Highlight type + (let ((name (substring response 0 (match-end 0))) + (type (propertize + (substring response (match-end 0)) + 'face 'eldoc-highlight-function-argument))) + (setq response (concat name type))))) + (when haskell-doc-prettify-types + (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) + (setq response + (replace-regexp-in-string (car re) (cdr re) response))))) + (when callback (funcall callback response))))) (when (and process expr-okay) - (haskell-process-queue-command - (haskell-process) - (make-haskell-command - :go (lambda (_) (haskell-process-send-string process ghci-command)) - :complete - (lambda (_ response) - ;; Responses with empty first line are likely errors - (if (string-match-p (rx string-start line-end) response) - (setq response nil) - ;; Remove a newline at the end - (setq response (replace-regexp-in-string "\n\\'" "" response)) - ;; Propertize for eldoc - (save-match-data - (when (string-match " :: " response) - ;; Highlight type - (let ((name (substring response 0 (match-end 0))) - (type (propertize - (substring response (match-end 0)) - 'face 'eldoc-highlight-function-argument))) - (setq response (concat name type))))) - (when haskell-doc-prettify-types - (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) - (setq response - (replace-regexp-in-string (car re) (cdr re) response))))) - (when callback (funcall callback response)))))))) + (if sync + (let ((response (haskell-process-queue-sync-request process ghci-command))) + (funcall complete-func nil response)) + (haskell-process-queue-command + process + (make-haskell-command + :go (lambda (_) (haskell-process-send-string process ghci-command)) + :complete complete-func)))))) (defun haskell-doc-sym-doc (sym) "Show the type of the function near point. From 5eb8ff5ae0d6954a7f2f4ee28c3fa17be2b01726 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Wed, 21 Jan 2015 16:05:07 -0500 Subject: [PATCH 4/8] Don't create new haskell process in eldoc Use haskell-session-maybe and haskell-session-process instead of haskell-process. --- haskell-doc.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/haskell-doc.el b/haskell-doc.el index a8ab52f85..b30dd8c54 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1622,8 +1622,7 @@ will be returned directly." sym (lambda (response) (setq haskell-doc-current-info--interaction-last (cons 'async response)) - (eldoc-print-current-symbol-info))) - 'async))))) + (eldoc-print-current-symbol-info)))))))) (defun haskell-process-get-type (expr-string &optional callback sync) "Asynchronously get the type of a given string. @@ -1633,7 +1632,8 @@ EXPR-STRING should be an expression passed to :type in ghci. CALLBACK will be called with a formatted type string. If SYNC is non-nil, make the call synchronously instead." - (let ((process (haskell-process)) + (let ((process (and (haskell-session-maybe) + (haskell-session-process (haskell-session-maybe)))) ;; Avoid passing bad strings to ghci (expr-okay (not (string-match-p "\n" expr-string))) (ghci-command (concat ":type " expr-string)) @@ -1666,7 +1666,8 @@ If SYNC is non-nil, make the call synchronously instead." process (make-haskell-command :go (lambda (_) (haskell-process-send-string process ghci-command)) - :complete complete-func)))))) + :complete complete-func)) + 'async)))) (defun haskell-doc-sym-doc (sym) "Show the type of the function near point. From c3b6d10aeb2bfbb77cad189811dcca15e487a694 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Wed, 21 Jan 2015 16:21:10 -0500 Subject: [PATCH 5/8] Use lexical-let instead of lexical-binding for compatibility purposes with older Emacs versions. --- haskell-doc.el | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/haskell-doc.el b/haskell-doc.el index b30dd8c54..0319c56d2 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1,4 +1,4 @@ -;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8; lexical-binding: t -*- +;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8 -*- ;; Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. ;; Copyright (C) 1997 Hans-Wolfgang Loidl @@ -342,6 +342,8 @@ ;;@node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables ;;@subsection Emacs portability +(eval-when-compile (require 'cl)) + (require 'haskell-mode) (require 'haskell-process) (require 'haskell) @@ -1632,13 +1634,14 @@ EXPR-STRING should be an expression passed to :type in ghci. CALLBACK will be called with a formatted type string. If SYNC is non-nil, make the call synchronously instead." + (unless callback (setq callback (lambda (response) (message "%s" response)))) (let ((process (and (haskell-session-maybe) (haskell-session-process (haskell-session-maybe)))) ;; Avoid passing bad strings to ghci (expr-okay (not (string-match-p "\n" expr-string))) (ghci-command (concat ":type " expr-string)) - (complete-func - (lambda (_ response) + (process-response + (lambda (response) ;; Responses with empty first line are likely errors (if (string-match-p (rx string-start line-end) response) (setq response nil) @@ -1656,17 +1659,23 @@ If SYNC is non-nil, make the call synchronously instead." (when haskell-doc-prettify-types (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) (setq response - (replace-regexp-in-string (car re) (cdr re) response))))) - (when callback (funcall callback response))))) + (replace-regexp-in-string (car re) (cdr re) response)))) + response)))) (when (and process expr-okay) (if sync (let ((response (haskell-process-queue-sync-request process ghci-command))) - (funcall complete-func nil response)) - (haskell-process-queue-command - process - (make-haskell-command - :go (lambda (_) (haskell-process-send-string process ghci-command)) - :complete complete-func)) + (funcall callback (funcall process-response response))) + (lexical-let ((process process) + (callback callback) + (ghci-command ghci-command) + (process-response process-response)) + (haskell-process-queue-command + process + (make-haskell-command + :go (lambda (_) (haskell-process-send-string process ghci-command)) + :complete + (lambda (_ response) + (funcall callback (funcall process-response response)))))) 'async)))) (defun haskell-doc-sym-doc (sym) From d489ca4d1b184cc5f235f391fb44a3a080b01a19 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Thu, 22 Jan 2015 17:01:28 -0500 Subject: [PATCH 6/8] In get-type check expression is not empty --- haskell-doc.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/haskell-doc.el b/haskell-doc.el index 0319c56d2..2fc7ad821 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1638,7 +1638,9 @@ If SYNC is non-nil, make the call synchronously instead." (let ((process (and (haskell-session-maybe) (haskell-session-process (haskell-session-maybe)))) ;; Avoid passing bad strings to ghci - (expr-okay (not (string-match-p "\n" expr-string))) + (expr-okay + (and (not (string-match-p "\\`[[:space:]]*\\'" expr-string)) + (not (string-match-p "\n" expr-string)))) (ghci-command (concat ":type " expr-string)) (process-response (lambda (response) From 189cc475561907b0e2475be1b089f31d5e23ce65 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Thu, 22 Jan 2015 17:28:21 -0500 Subject: [PATCH 7/8] Make do-type (C-c C-t) work with selected region. --- haskell-commands.el | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/haskell-commands.el b/haskell-commands.el index d507ec625..1ec9ae351 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -336,15 +336,24 @@ If PROMPT-VALUE is non-nil, request identifier via mini-buffer." (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))) + (let* ((expr + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)) + (haskell-ident-at-point))) + (expr-okay (and expr + (not (string-match-p "\\`[[:space:]]*\\'" expr)) + (not (string-match-p "\n" expr))))) + ;; No newlines in expressions, and surround with parens if it + ;; might be a slice expression + (when expr-okay + (haskell-process-do-simple-echo + (format + (if (or (string-match-p "\\`(" expr) + (string-match-p "\\`[_[:alpha:]]" expr)) + ":type %s" + ":type (%s)") + expr) + 'haskell-mode))))) ;;;###autoload (defun haskell-mode-jump-to-def-or-tag (&optional next-p) From 4efab433f025e61072e9f8b114caf4d51e3f40b8 Mon Sep 17 00:00:00 2001 From: Kirill Ignatiev Date: Thu, 22 Jan 2015 17:35:50 -0500 Subject: [PATCH 8/8] Strip empty line at end of echoed type The empty line doesn't mean anything useful, and the change in behaviour doesn't affect any other functions. --- haskell-interactive-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell-interactive-mode.el b/haskell-interactive-mode.el index 949a9d741..4681194b2 100644 --- a/haskell-interactive-mode.el +++ b/haskell-interactive-mode.el @@ -1090,7 +1090,7 @@ haskell-present, depending on configuration." ;; `haskell-process-use-presentation-mode' is t. (haskell-interactive-mode-echo (haskell-process-session (car state)) - response + (replace-regexp-in-string "\n\\'" "" response) (cl-caddr state)) (if haskell-process-use-presentation-mode (progn (haskell-present (cadr state)