From f8521d90e7c200c07a84328c8d19e2993aad15ac Mon Sep 17 00:00:00 2001 From: Antal Spector-Zabusky Date: Sat, 25 Apr 2015 03:18:28 -0400 Subject: [PATCH 1/4] Dealt with `haskell-ident-at-point` returning nil. The documentation mandates that `haskell-ident-at-point` return nil when there is no identifier at point; however, apparently, it instead returned `""` in that case at some point, and so some code made faulty assumptions based on that. --- haskell-commands.el | 145 +++++++++++++++++++++++--------------------- haskell-doc.el | 2 +- haskell.el | 8 +-- inf-haskell.el | 10 +-- 4 files changed, 87 insertions(+), 78 deletions(-) diff --git a/haskell-commands.el b/haskell-commands.el index c94d49a63..05d05ad3f 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -279,23 +279,28 @@ given a prefix arg." "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 (replace-regexp-in-string - "^!\\([A-Z_a-z]\\)" - "\\1" - (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)) + (let ((at-point (haskell-ident-at-point))) + (when (or prompt-value at-point) + (let* ((ident (replace-regexp-in-string + "^!\\([A-Z_a-z]\\)" + "\\1" + (if prompt-value + (read-from-minibuffer "Info: " at-point) + at-point))) + (modname (unless prompt-value + (haskell-utils-parse-import-statement-at-point))) + (command (cond + (modname + (format ":browse! %s" modname)) + ((string= ident "") ; For the minibuffer input case + nil) + (t (format (if (string-match "^[a-zA-Z_]" ident) + ":info %s" + ":info (%s)") + (or ident + at-point)))))) + (when command + (haskell-process-do-simple-echo command 'haskell-mode)))))) ;;;###autoload (defun haskell-process-do-type (&optional insert-value) @@ -369,67 +374,71 @@ to to get there." (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))))))))))) + (let ((ident (haskell-ident-at-point))) + (when ident + (let ((process (haskell-interactive-process)) + (query (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. +to find the location. Returns `nil' if it can't find the +identifier or the identifier isn't a string. Returns: (library ) (file ) (module ) + nil " - (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)))))))))))))) + (when (stringp ident) + (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))))))))))))))) ;;;###autoload (defun haskell-mode-jump-to-def (ident) diff --git a/haskell-doc.el b/haskell-doc.el index a99e57416..f70c76c2e 100644 --- a/haskell-doc.el +++ b/haskell-doc.el @@ -1677,7 +1677,7 @@ If `haskell-doc-use-inf-haskell' is non-nil, this function will consult the inferior Haskell process for type/kind information, rather than using the haskell-doc database." (if haskell-doc-use-inf-haskell - (unless (string= "" sym) + (unless (or (null sym) (string= "" sym)) (let* ((message-log-max nil) (result (ignore-errors (unwind-protect diff --git a/haskell.el b/haskell.el index d7739b321..41be83820 100644 --- a/haskell.el +++ b/haskell.el @@ -299,11 +299,11 @@ (insert (cdr mapping))) (insert module))) (haskell-mode-format-imports))) - ((not (string= "" (save-excursion (forward-char -1) (haskell-ident-at-point)))) + (t (let ((ident (save-excursion (forward-char -1) (haskell-ident-at-point)))) (insert " ") - (haskell-process-do-try-info ident))) - (t (insert " "))))) + (when ident + (haskell-process-do-try-info ident))))))) ;;;###autoload (defun haskell-mode-jump-to-tag (&optional next-p) @@ -312,7 +312,7 @@ (let ((ident (haskell-ident-at-point)) (tags-file-name (haskell-session-tags-filename (haskell-session))) (tags-revert-without-query t)) - (when (not (string= "" (haskell-string-trim ident))) + (when (and (stringp ident) (not (string= "" (haskell-string-trim ident)))) (cond ((file-exists-p tags-file-name) (find-tag ident next-p)) (t (haskell-process-generate-tags ident)))))) diff --git a/inf-haskell.el b/inf-haskell.el index b5a39f152..760a6c148 100644 --- a/inf-haskell.el +++ b/inf-haskell.el @@ -490,7 +490,7 @@ in the buffer. This can be done interactively with the \\[universal-argument] p The returned info is cached for reuse by `haskell-doc-mode'." (interactive (let ((sym (haskell-ident-at-point))) - (list (read-string (if (> (length sym) 0) + (list (read-string (if sym (format "Show type of (default %s): " sym) "Show type of: ") nil nil sym) @@ -526,7 +526,7 @@ The returned info is cached for reuse by `haskell-doc-mode'." "Query the haskell process for the kind of the given expression." (interactive (let ((type (haskell-ident-at-point))) - (list (read-string (if (> (length type) 0) + (list (read-string (if type (format "Show kind of (default %s): " type) "Show kind of: ") nil nil type)))) @@ -539,7 +539,7 @@ The returned info is cached for reuse by `haskell-doc-mode'." "Query the haskell process for the info of the given expression." (interactive (let ((sym (haskell-ident-at-point))) - (list (read-string (if (> (length sym) 0) + (list (read-string (if sym (format "Show info of (default %s): " sym) "Show info of: ") nil nil sym)))) @@ -552,7 +552,7 @@ The returned info is cached for reuse by `haskell-doc-mode'." "Attempt to locate and jump to the definition of the given expression." (interactive (let ((sym (haskell-ident-at-point))) - (list (read-string (if (> (length sym) 0) + (list (read-string (if sym (format "Find definition of (default %s): " sym) "Find definition of: ") nil nil sym)))) @@ -771,7 +771,7 @@ see if this is newer than `haskell-package-conf-file' every time we load it." (interactive (let ((sym (haskell-ident-at-point))) - (list (read-string (if (> (length sym) 0) + (list (read-string (if sym (format "Find documentation of (default %s): " sym) "Find documentation of: ") nil nil sym)))) From 6a3257c54cf77084d106483090c393e18331cc4d Mon Sep 17 00:00:00 2001 From: Antal Spector-Zabusky Date: Sat, 25 Apr 2015 04:25:51 -0400 Subject: [PATCH 2/4] Made `haskell-ident-pos-at-point` return `nil`. The documentation mandates that `haskell-ident-pos-at-point` return nil when there is no identifier at point; however, it instead returned a cons cell of the form `(n . n)`. This is now fixed, and any code that relied on this behavior has been changed. This also therefore fixes `haskell-spanable-pos-at-point` in the same way. --- haskell-commands.el | 43 +++++++++++++++++++++++-------------------- haskell-mode.el | 18 +++++++++--------- 2 files changed, 32 insertions(+), 29 deletions(-) diff --git a/haskell-commands.el b/haskell-commands.el index 05d05ad3f..40c6ea9a2 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -621,26 +621,29 @@ command from GHCi." (interactive "P") (let ((ty (haskell-mode-type-at)) (orig (point))) - (if insert-value - (let ((ident-pos (haskell-ident-pos-at-point))) - (cond - ((region-active-p) - (delete-region (region-beginning) - (region-end)) - (insert "(" ty ")") - (goto-char (1+ orig))) - ((= (line-beginning-position) (car ident-pos)) - (goto-char (line-beginning-position)) - (insert (haskell-fontify-as-mode ty 'haskell-mode) - "\n")) - (t - (save-excursion - (goto-char (car ident-pos)) - (let ((col (current-column))) - (save-excursion (insert "\n") - (indent-to col)) - (insert (haskell-fontify-as-mode ty 'haskell-mode))))))) - (message "%s" (haskell-fontify-as-mode ty 'haskell-mode))))) + (unless (= (aref ty 0) ?\n) + ;; That seems to be what happens when `haskell-mode-type-at` fails + (if insert-value + (let ((ident-pos (or (haskell-ident-pos-at-point) + (cons (point) (point))))) + (cond + ((region-active-p) + (delete-region (region-beginning) + (region-end)) + (insert "(" ty ")") + (goto-char (1+ orig))) + ((= (line-beginning-position) (car ident-pos)) + (goto-char (line-beginning-position)) + (insert (haskell-fontify-as-mode ty 'haskell-mode) + "\n")) + (t + (save-excursion + (goto-char (car ident-pos)) + (let ((col (current-column))) + (save-excursion (insert "\n") + (indent-to col)) + (insert (haskell-fontify-as-mode ty 'haskell-mode))))))) + (message "%s" (haskell-fontify-as-mode ty 'haskell-mode)))))) ;;;###autoload (defun haskell-process-generate-tags (&optional and-then-find-this-tag) diff --git a/haskell-mode.el b/haskell-mode.el index cd58f23be..497a0b9b5 100644 --- a/haskell-mode.el +++ b/haskell-mode.el @@ -486,19 +486,18 @@ Run M-x describe-variable haskell-mode-hook for a list of such modes.")) May return a qualified name." (let ((reg (haskell-ident-pos-at-point))) (when reg - (unless (= (car reg) (cdr reg)) - (buffer-substring-no-properties (car reg) (cdr reg)))))) + (buffer-substring-no-properties (car reg) (cdr reg))))) (defun haskell-spanable-pos-at-point () "Like `haskell-ident-pos-at-point', but includes any surrounding backticks." (save-excursion (let ((pos (haskell-ident-pos-at-point))) - (if pos - (cl-destructuring-bind (start . end) pos - (if (and (eq ?` (char-before start)) - (eq ?` (char-after end))) - (cons (- start 1) (+ end 1)) - (cons start end))))))) + (when pos + (cl-destructuring-bind (start . end) pos + (if (and (eq ?` (char-before start)) + (eq ?` (char-after end))) + (cons (- start 1) (+ end 1)) + (cons start end))))))) (defun haskell-ident-pos-at-point () "Return the span of the identifier under point, or nil if none found. @@ -536,7 +535,8 @@ May return a qualified name." (looking-at "[[:upper:]]")) (setq start (point))) ;; This is it. - (cons start end))))) + (unless (= start end) + (cons start end)))))) (defun haskell-delete-indentation (&optional arg) "Like `delete-indentation' but ignoring Bird-style \">\"." From c4cbd61a1ed015e76840415a90972c955f111d2a Mon Sep 17 00:00:00 2001 From: Antal Spector-Zabusky Date: Sat, 25 Apr 2015 05:45:55 -0400 Subject: [PATCH 3/4] Added tests for `haskell-ident-at-point` & friends As gracjan requested in #603, I > * add[ed] a test case for haskell-ident-at-point really returning nil when it should > * add[ed] a test case for haskell-ident-pos-at-point returning non-nil > * add[ed] a test case for haskell-ident-pos-at-point returning nil > * add[ed] a test case for haskell-spanable-pos-at-point returning non-nil > * add[ed] a test case for haskell-spanable-pos-at-point returning nil I added some somewhat detailed `nil`-checking, a couple quick tests for `haskell-{ident,spanable}-pos-at-point` that just try the same unicode identifiers, and then some tests to distinguish `haskell-spanable-pos-at-point` by using an identifier in backticks. Any test for `haskell-ident-at-point` could also be a test for the other two, so that's a potential source of more tests; however, the definitions of the functions in terms of `haskell-ident-pos-at-point` are so simple that this didn't seem to add much (especially given the sheer amount of test duplication). --- tests/haskell-mode-tests.el | 93 ++++++++++++++++++++++++++++++++++++- 1 file changed, 92 insertions(+), 1 deletion(-) diff --git a/tests/haskell-mode-tests.el b/tests/haskell-mode-tests.el index c3668d326..2d17b1517 100644 --- a/tests/haskell-mode-tests.el +++ b/tests/haskell-mode-tests.el @@ -25,6 +25,49 @@ (haskell-mode) (eq nil (haskell-ident-at-point))))) +(ert-deftest empty-pos () + (should (with-temp-buffer + (haskell-mode) + (eq nil (haskell-ident-pos-at-point))))) + +(ert-deftest empty-spanable () + (should (with-temp-buffer + (haskell-mode) + (eq nil (haskell-spanable-pos-at-point))))) + +(ert-deftest aftercolons () + (should (with-temp-buffer + (haskell-mode) + (insert "foo ::") + (eq nil (haskell-ident-at-point))))) + +(ert-deftest aftercolons-pos () + (should (with-temp-buffer + (haskell-mode) + (insert "foo ::") + (eq nil (haskell-ident-pos-at-point))))) + +(ert-deftest beforetype () + (should (with-temp-buffer + (haskell-mode) + (insert "foo ::") + (save-excursion (insert " bar -> baz")) + (eq nil (haskell-ident-at-point))))) + +(ert-deftest beforetype-pos () + (should (with-temp-buffer + (haskell-mode) + (insert "foo ::") + (save-excursion (insert " bar -> baz")) + (eq nil (haskell-ident-pos-at-point))))) + +(ert-deftest beforetype-spanable () + (should (with-temp-buffer + (haskell-mode) + (insert "foo ::") + (save-excursion (insert " bar -> baz")) + (eq nil (haskell-spanable-pos-at-point))))) + (ert-deftest single () (should (with-temp-buffer (haskell-mode) @@ -127,7 +170,55 @@ (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") - (string= "Äöèąċōïá" (haskell-ident-at-point))))) + (string= "Äöèąċōïá" (haskell-ident-at-point))))) + +(ert-deftest unicode-pos () + (should (with-temp-buffer + (haskell-mode) + (insert "åöèą5ċōïá") + (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) + +(ert-deftest unicode2-pos () + (should (with-temp-buffer + (haskell-mode) + (insert "Äöèąċōïá") + (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) + +(ert-deftest unicode-spanable () + (should (with-temp-buffer + (haskell-mode) + (insert "åöèą5ċōïá") + (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) + +(ert-deftest unicode2-spanable () + (should (with-temp-buffer + (haskell-mode) + (insert "Äöèąċōïá") + (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) + +(ert-deftest ident-in-backticks () + (should (with-temp-buffer + (haskell-mode) + (insert "`foo`") + (backward-char 2) + (string= "foo" (haskell-ident-at-point))))) + +(ert-deftest ident-pos-in-backticks () + (should (with-temp-buffer + (haskell-mode) + (insert "`foo`") + (backward-char 2) + (equal (cons (1+ (point-min)) (1- (point-max))) + (haskell-ident-pos-at-point))))) + +(ert-deftest spanable-pos-in-backticks () + (should (with-temp-buffer + (haskell-mode) + (insert "`foo`") + (backward-char 2) + (equal (cons (point-min) (point-max)) + (haskell-spanable-pos-at-point))))) + (defun check-fill (expected initial) "Check using ERT if `fill-paragraph' over `initial' gives From 263d7b56e63e32f2be00bc50e0304f0203fd4c77 Mon Sep 17 00:00:00 2001 From: Antal Spector-Zabusky Date: Sat, 25 Apr 2015 05:50:21 -0400 Subject: [PATCH 4/4] Fail-fast in `haskell-mode-jump-to-tag` `haskell-mode-jump-to-tag` will now crash if given a non-`nil` non-string (inside `haskell-string-trim`), as gracjan requested in #603. --- haskell.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell.el b/haskell.el index 41be83820..96449e5e8 100644 --- a/haskell.el +++ b/haskell.el @@ -312,7 +312,7 @@ (let ((ident (haskell-ident-at-point)) (tags-file-name (haskell-session-tags-filename (haskell-session))) (tags-revert-without-query t)) - (when (and (stringp ident) (not (string= "" (haskell-string-trim ident)))) + (when (and ident (not (string= "" (haskell-string-trim ident)))) (cond ((file-exists-p tags-file-name) (find-tag ident next-p)) (t (haskell-process-generate-tags ident))))))