diff --git a/haskell-mode.el b/haskell-mode.el index 780c94878..9e973f227 100644 --- a/haskell-mode.el +++ b/haskell-mode.el @@ -599,7 +599,7 @@ executable found in PATH.") (goto-char end))))))) (defun haskell-ident-at-point () - "Return the identifier under point, or nil if none found. + "Return the identifier near point going backward or nil if none found. May return a qualified name." (let ((reg (haskell-ident-pos-at-point))) (when reg @@ -617,44 +617,107 @@ May return a qualified name." (cons start end))))))) (defun haskell-ident-pos-at-point () - "Return the span of the identifier under point, or nil if none found. -May return a qualified name." - (save-excursion - ;; Skip whitespace if we're on it. That way, if we're at "map ", we'll - ;; see the word "map". - (if (and (not (eobp)) - (eq ? (char-syntax (char-after)))) - (skip-chars-backward " \t")) - - (let ((case-fold-search nil)) - (cl-multiple-value-bind (start end) - (list - (progn (skip-syntax-backward "w_") (point)) - (progn (skip-syntax-forward "w_") (point))) - ;; If we're looking at a module ID that qualifies further IDs, add - ;; those IDs. - (goto-char start) - (while (and (looking-at "[[:upper:]]") (eq (char-after end) ?.) - ;; It's a module ID that qualifies further IDs. - (goto-char (1+ end)) - (save-excursion - (when (not (zerop (skip-syntax-forward - (if (looking-at "\\s_") "_" "w'")))) - (setq end (point)))))) - ;; If we're looking at an ID that's itself qualified by previous - ;; module IDs, add those too. - (goto-char start) - (if (eq (char-after) ?.) (forward-char 1)) ;Special case for "." - (while (and (eq (char-before) ?.) - (progn (forward-char -1) - (not (zerop (skip-syntax-backward "w'")))) - (skip-syntax-forward "'") - (looking-at "[[:upper:]]")) - (setq start (point))) - ;; This is it. - (unless (= start end) + "Return the span of the identifier near point going backward. +Returns nil if no identifier found or point is inside string or +comment. May return a qualified name." + (when (not (nth 8 (syntax-ppss))) + ;; Do not handle comments and strings + (let (start end) + ;; Initial point position is non-deterministic, it may occur anywhere + ;; inside identifier span, so the approach is: + ;; - first try go left and find left boundary + ;; - then try go right and find right boundary + ;; + ;; In both cases assume the longest path, e.g. when going left take into + ;; account than point may occur at the end of identifier, when going right + ;; take into account that point may occur at the beginning of identifier. + ;; + ;; We should handle `.` character very careful because it is heavily + ;; overloaded. Examples of possible cases: + ;; Control.Monad.>>= -- delimiter + ;; Control.Monad.when -- delimiter + ;; Data.Aeson..: -- delimiter and operator symbol + ;; concat.map -- composition function + ;; .? -- operator symbol + (save-excursion + ;; First, skip whitespace if we're on it, moving point to last + ;; identifier char. That way, if we're at "map ", we'll see the word + ;; "map". + (when (and (looking-at (rx eol)) + (not (bolp))) + (backward-char)) + (when (and (not (eobp)) + (eq (char-syntax (char-after)) ? )) + (skip-chars-backward " \t") + (backward-char)) + ;; Now let's try to go left. + (save-excursion + (if (not (haskell-mode--looking-at-varsym)) + ;; Looking at non-operator char, this is quite simple + (progn + (skip-syntax-backward "w_") + ;; Remember position + (setq start (point))) + ;; Looking at operator char. + (while (and (not (bobp)) + (haskell-mode--looking-at-varsym)) + ;; skip all operator chars backward + (setq start (point)) + (backward-char)) + ;; Extra check for case when reached beginning of the buffer. + (when (haskell-mode--looking-at-varsym) + (setq start (point)))) + ;; Slurp qualification part if present. If identifier is qualified in + ;; case of non-operator point will stop before `.` dot, but in case of + ;; operator it will stand at `.` delimiting dot. So if we're looking + ;; at `.` let's step one char forward and try to get qualification + ;; part. + (goto-char start) + (when (looking-at-p (rx ".")) + (forward-char)) + (let ((pos (haskell-mode--skip-qualification-backward))) + (when pos + (setq start pos)))) + ;; Finally, let's try to go right. + (save-excursion + ;; Try to slurp qualification part first. + (skip-syntax-forward "w_") + (setq end (point)) + (while (and (looking-at (rx "." upper)) + (not (zerop (progn (forward-char) + (skip-syntax-forward "w_"))))) + (setq end (point))) + ;; If point was at non-operator we already done, otherwise we need an + ;; extra check. + (while (haskell-mode--looking-at-varsym) + (forward-char) + (setq end (point)))) + (when (not (= start end)) (cons start end)))))) +(defun haskell-mode--looking-at-varsym () + "Return t when point stands at operator symbol." + (when (not (eobp)) + (let ((lex (haskell-lexeme-classify-by-first-char (char-after)))) + (or (eq lex 'varsym) + (eq lex 'consym))))) + +(defun haskell-mode--skip-qualification-backward () + "Skip qualified part of identifier backward. +Expects point stands *after* delimiting dot. +Returns beginning position of qualified part or nil if no qualified part found." + (when (not (and (bobp) + (looking-at (rx bol)))) + (let ((case-fold-search nil) + pos) + (while (and (eq (char-before) ?.) + (progn (backward-char) + (not (zerop (skip-syntax-backward "w'")))) + (skip-syntax-forward "'") + (looking-at "[[:upper:]]")) + (setq pos (point))) + pos))) + (defun haskell-delete-indentation (&optional arg) "Like `delete-indentation' but ignoring Bird-style \">\"." (interactive "*P") diff --git a/tests/haskell-completions-tests.el b/tests/haskell-completions-tests.el index c89668573..36730624a 100644 --- a/tests/haskell-completions-tests.el +++ b/tests/haskell-completions-tests.el @@ -353,8 +353,7 @@ identifiers and module identifiers." (should (equal expected (haskell-completions-grab-identifier-prefix))) (should (equal expected (haskell-completions-grab-prefix))) (insert " (T.pack (\"Hello") - (setq expected - (list 108 113 "Hello" 'haskell-completions-general-prefix)) + (setq expected nil) (should (equal expected (haskell-completions-grab-identifier-prefix))) (should (equal expected (haskell-completions-grab-prefix))) (insert " World!\" :: String") @@ -363,8 +362,7 @@ identifiers and module identifiers." (should (equal expected (haskell-completions-grab-identifier-prefix))) (should (equal expected (haskell-completions-grab-prefix))) (insert " -- Comment") - (setq expected - (list 135 142 "Comment" 'haskell-completions-general-prefix)) + (setq expected nil) (should (equal expected (haskell-completions-grab-identifier-prefix))) (should (equal expected (haskell-completions-grab-prefix)))) ;; test in the middle of line diff --git a/tests/haskell-mode-tests.el b/tests/haskell-mode-tests.el index 09bdf2ba1..84541debd 100644 --- a/tests/haskell-mode-tests.el +++ b/tests/haskell-mode-tests.el @@ -20,190 +20,193 @@ (require 'ert) (require 'haskell-mode) -(ert-deftest empty () +(ert-deftest haskell-mode-ident-at-point-empty () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-ident-at-point))))) -(ert-deftest empty-pos () +(ert-deftest haskell-mode-ident-pos-at-point-empty () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-ident-pos-at-point))))) -(ert-deftest empty-spanable () +(ert-deftest haskell-mode-spanable-pos-at-point-empty-spanable () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-spanable-pos-at-point))))) -(ert-deftest aftercolons () +(ert-deftest haskell-mode-ident-at-point-aftercolons () (should (with-temp-buffer (haskell-mode) (insert "foo ::") - (eq nil (haskell-ident-at-point))))) + (string= "::" (haskell-ident-at-point))))) -(ert-deftest aftercolons-pos () +(ert-deftest haskell-mode-ident-pos-at-point-aftercolons () (should (with-temp-buffer (haskell-mode) (insert "foo ::") - (eq nil (haskell-ident-pos-at-point))))) + (not (eq nil (haskell-ident-pos-at-point)))))) -(ert-deftest beforetype () +(ert-deftest haskell-mode-ident-at-point-beforetype () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) - (eq nil (haskell-ident-at-point))))) + (string= "::" (haskell-ident-at-point))))) -(ert-deftest beforetype-pos () +(ert-deftest haskell-mode-ident-pos-at-point-beforetype () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) - (eq nil (haskell-ident-pos-at-point))))) + (not (eq nil (haskell-ident-pos-at-point)))))) -(ert-deftest beforetype-spanable () +(ert-deftest haskell-mode-spanable-pos-at-point-beforetype () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) - (eq nil (haskell-spanable-pos-at-point))))) + (not (eq nil (haskell-spanable-pos-at-point)))))) -(ert-deftest single () +(ert-deftest haskell-mode-ident-at-point-single () (should (with-temp-buffer (haskell-mode) (insert "a") (string= "a" (haskell-ident-at-point))))) -(ert-deftest constructor () +(ert-deftest haskell-mode-ident-at-point-constructor () (should (with-temp-buffer (haskell-mode) (insert "Hello123") (string= "Hello123" (haskell-ident-at-point))))) -(ert-deftest in-string () +(ert-deftest haskell-mode-ident-at-point-in-string () (should (with-temp-buffer (haskell-mode) (insert "\"Hello\"") (goto-char (1- (point-max))) - (string= "Hello" (haskell-ident-at-point))))) + (eq nil (haskell-ident-at-point))))) -(ert-deftest in-commas () +(ert-deftest haskell-mode-ident-at-point-in-commas () (should (with-temp-buffer (haskell-mode) (insert ",Hello,") (goto-char (1- (point-max))) (string= "Hello" (haskell-ident-at-point))))) -(ert-deftest var () +(ert-deftest haskell-mode-ident-at-point-var () (should (with-temp-buffer (haskell-mode) (insert "hello") (string= "hello" (haskell-ident-at-point))))) -(ert-deftest prime () +(ert-deftest haskell-mode-ident-at-point-prime () (should (with-temp-buffer (haskell-mode) (insert "f'") (string= "f'" (haskell-ident-at-point))))) -(ert-deftest prime2 () +(ert-deftest haskell-mode-ident-at-point-prime2 () (should (with-temp-buffer (haskell-mode) (insert "f5oo'") (string= "f5oo'" (haskell-ident-at-point))))) -(ert-deftest prime3 () +(ert-deftest haskell-mode-ident-at-point-prime3 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (string= "f'oo'" (haskell-ident-at-point))))) -(ert-deftest prime4 () +(ert-deftest haskell-mode-ident-at-point-prime4 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (goto-char (point-min)) (string= "f'oo'" (haskell-ident-at-point))))) -(ert-deftest prime5 () +(ert-deftest haskell-mode-ident-at-point-prime5 () (should (with-temp-buffer (haskell-mode) (insert "f'o6o'") (goto-char (+ 1 (point-min))) (string= "f'o6o'" (haskell-ident-at-point))))) -(ert-deftest prime6 () +(ert-deftest haskell-mode-ident-at-point-prime6 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (goto-char (+ 2 (point-min))) (string= "f'oo'" (haskell-ident-at-point))))) -(ert-deftest underscore () +(ert-deftest haskell-mode-ident-at-point-underscore () (should (with-temp-buffer (haskell-mode) (insert "f_oo_") (goto-char (+ 2 (point-min))) (string= "f_oo_" (haskell-ident-at-point))))) - -(ert-deftest underscore2 () +(ert-deftest haskell-mode-ident-at-point-underscore2 () (should (with-temp-buffer (haskell-mode) (insert "_oo_") (goto-char (point-min)) (string= "_oo_" (haskell-ident-at-point))))) -(ert-deftest underscore3 () +(ert-deftest haskell-mode-ident-at-point-underscore3 () (should (with-temp-buffer (haskell-mode) (insert "o3o_") (string= "o3o_" (haskell-ident-at-point))))) -(ert-deftest unicode () +(ert-deftest haskell-mode-ident-at-point-unicode () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") (string= "åöèą5ċōïá" (haskell-ident-at-point))))) -(ert-deftest unicode2 () +(ert-deftest haskell-mode-ident-at-point-unicode2 () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") (string= "Äöèąċōïá" (haskell-ident-at-point))))) -(ert-deftest unicode-pos () +(ert-deftest haskell-mode-ident-pos-at-point-unicode () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") - (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) + (equal (cons (point-min) (point-max)) + (haskell-ident-pos-at-point))))) -(ert-deftest unicode2-pos () +(ert-deftest haskell-mode-ident-pos-at-point-unicode2 () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") - (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) + (equal (cons (point-min) (point-max)) + (haskell-ident-pos-at-point))))) -(ert-deftest unicode-spanable () +(ert-deftest haskell-mode-spanable-pos-at-point-unicode () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") - (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) + (equal (cons (point-min) (point-max)) + (haskell-spanable-pos-at-point))))) -(ert-deftest unicode2-spanable () +(ert-deftest haskell-mode-spanable-pos-at-point-unicode2 () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") - (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) + (equal (cons (point-min) (point-max)) + (haskell-spanable-pos-at-point))))) -(ert-deftest ident-in-backticks () +(ert-deftest haskell-mode-ident-at-point-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 () +(ert-deftest haskell-mode-ident-pos-at-point-in-backticks () (should (with-temp-buffer (haskell-mode) (insert "`foo`") @@ -211,7 +214,7 @@ (equal (cons (1+ (point-min)) (1- (point-max))) (haskell-ident-pos-at-point))))) -(ert-deftest spanable-pos-in-backticks () +(ert-deftest haskell-mode-spanable-pos-at-point-in-backticks () (should (with-temp-buffer (haskell-mode) (insert "`foo`") @@ -219,6 +222,53 @@ (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) +(ert-deftest haskell-mode-ident-at-point-operators () + "Test `haskell-ident-at-point' for all operator cases." + (with-temp-buffer + (haskell-mode) + ;; point at the end of unqualified operator + (insert ">>") + (should (string= ">>" (haskell-ident-at-point))) + ;; point in the middle of unqualified operator + (save-excursion + (insert "=") + (insert "\n")) + (should (string= ">>=" (haskell-ident-at-point))) + (forward-line) + ;; point at the end of qualified operator + (insert "Control.Monad.>>=") + (should (string= "Control.Monad.>>=" (haskell-ident-at-point))) + ;; point at the beginning of qualified operator + (goto-char (line-beginning-position)) + (should (string= "Control.Monad.>>=" (haskell-ident-at-point))) + ;; point in the middle of qualified part of operator + (forward-char) + (should (string= "Control.Monad.>>=" (haskell-ident-at-point))) + ;; point atfer `.` dot in qualified part of operator + (search-forward ".") + (should (string= "Control.Monad.>>=" (haskell-ident-at-point))) + ;; point at `.` dot in qualified part + (backward-char) + (should (string= "Control.Monad.>>=" (haskell-ident-at-point))) + (goto-char (line-end-position)) + (insert "\n") + ;; Overloaded `.` dot tests. + ;; point at operator's `.` dot preceded by delimiting `.` dot + (insert "Data.Aeson.") + (save-excursion + (insert ".:")) + (should (string= "Data.Aeson..:" (haskell-ident-at-point))) + (forward-char) + (should (string= "Data.Aeson..:" (haskell-ident-at-point))) + ;; surrounding parentheses + (goto-char (line-beginning-position)) + (save-excursion (insert "(")) + (should (eq nil (haskell-ident-at-point))) + (goto-char (line-end-position)) + (insert ")") + (should (eq nil (haskell-ident-at-point))) + (backward-char 2) + (should (string= "Data.Aeson..:" (haskell-ident-at-point))))) (defun check-fill (expected initial) "Check using ERT if `fill-paragraph' over `initial' gives