[nongnu] elpa/haskell-tng-mode aca98c2 333/385: simplify import-symbol-at-point logic

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit aca98c257bc7ed5c9ae964312768a1be7e00036f
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    simplify import-symbol-at-point logic
---
 haskell-tng-extra-company.el |   4 +-
 haskell-tng-hsinspect.el     | 101 +++++++++++++++++++++++++------------------
 2 files changed, 60 insertions(+), 45 deletions(-)

diff --git a/haskell-tng-extra-company.el b/haskell-tng-extra-company.el
index 50efbde..5051b13 100644
--- a/haskell-tng-extra-company.el
+++ b/haskell-tng-extra-company.el
@@ -42,11 +42,11 @@
                       (eq (char-before) ?.))
                   (buffer-substring-no-properties
                    (save-excursion
+                     ;; TODO reuse haskell-tng--hsinspect-symbol-at-point
                      (funcall smie-backward-token-function)
                      (let ((lbp (line-beginning-position)))
-                       ;; include FQNs, workaround ungreedy backwards regexp
+                       ;; WORKAROUND non-greedy matches
                        (while (looking-back haskell-tng--rx-c-qual lbp 't)
-                         ;; TODO try regexp without while
                          (goto-char (match-beginning 0))))
                      (point))
                    (point))))
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 6996c0f..2d45224 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -25,6 +25,7 @@
 (require 'popup)
 
 (require 'haskell-tng-compile)
+(require 'haskell-tng-rx)
 (require 'haskell-tng-util)
 
 ;;;###autoload
@@ -53,6 +54,12 @@ A prefix argument ensures that caches are flushes."
     ("Data.ByteString.Lazy" . "LBS"))
   "An alist of (MODULE . NAME) to use for qualified imports.")
 (put 'haskell-tng-hsinspect-as 'safe-local-variable #'listp)
+(defun haskell-tng--hsinspect-as (module)
+  (or
+   (alist-get module haskell-tng-hsinspect-as nil nil 'equal)
+   (read-string
+    (concat "import qualified " module " as ")
+    (car (last (split-string module (regexp-quote ".")))))))
 
 (defcustom haskell-tng-hsinspect-qualify nil
   "`haskell-tng-import-symbol-at-point' will prefer qualified imports."
@@ -71,45 +78,46 @@ qualified and the user will be asked for the name 
(behaviour is
 reversed if `haskell-tng-hsinspect-qualify' is set).
 
 Respects the `C-u' cache invalidation convention."
-  ;; TODO fqn version doesn't work one after the last character and non-fqn 
version doesn't work on first
   (interactive "P")
-  ;; FIXME update the hsinspect-imports cache
-  (let ((flush-cache (and alt (not (eq '- alt)))))
+  ;; TODO add parens around operators (or should that be in the utility?)
+  (let (qual
+        (flush-cache (and alt (not (eq '- alt)))))
     (when-let* ((index (haskell-tng--hsinspect-index flush-cache))
                 (sym (haskell-tng--hsinspect-symbol-at-point)))
       (message "Seaching for '%s' in %s modules" sym (length index))
-      (if (string-match (rx bos (group (+ anything)) "." (group (+ (not (any 
".")))) eos) sym)
-          (let* ((fqn (match-string 1 sym))
-                 (sym (match-string 2 sym)))
-            (when-let (hit (haskell-tng--hsinspect-import-popup index sym))
-              (haskell-tng--import-symbol (alist-get 'module hit) fqn)))
-        (when-let* ((hit (haskell-tng--hsinspect-import-popup index sym))
-                    (module (alist-get 'module hit)))
-          ;; TODO add parens around operators (or should that be in the 
utility?)
-          (if (xor haskell-tng-hsinspect-qualify (eq '- alt))
-              (let ((fqn (or
-                          (alist-get module haskell-tng-hsinspect-as nil nil 
'equal)
-                          (read-string
-                           (concat "import qualified " module " as ")
-                           (car (last (split-string module (regexp-quote 
"."))))))))
-                (haskell-tng--import-symbol module fqn)
-                (save-excursion
-                  (unless (looking-at (regexp-quote sym))
-                    (re-search-backward
-                     (rx symbol-start (+ (| word (syntax symbol))) point)
-                     (line-beginning-position)
-                     'no-error))
-                  (insert fqn ".")))
-            (pcase (alist-get 'class hit)
-              ('tycon
-               (haskell-tng--import-symbol
-                module nil
-                (haskell-tng--hsinspect-return-type (alist-get 'type hit))))
-              ('con
-               (haskell-tng--import-symbol
-                module nil
-                (concat (haskell-tng--hsinspect-return-type (alist-get 'type 
hit)) "(..)")))
-              (_ (haskell-tng--import-symbol module nil (alist-get 'name 
hit))))))))))
+
+      (when (string-match (rx bos (group (+ anything)) "." (group (+ (not (any 
".")))) eos) sym)
+        (setq qual (match-string 1 sym))
+        (setq sym (match-string 2 sym)))
+
+      (when-let (hit (haskell-tng--hsinspect-import-popup index sym))
+        (let* ((module (alist-get 'module hit))
+               (class (alist-get 'class hit))
+               (type (alist-get 'type hit))
+               (name (alist-get 'name hit)))
+          (cond
+           (qual (haskell-tng--import-symbol module qual))
+
+           ((xor haskell-tng-hsinspect-qualify (eq '- alt))
+            (when-let (as (haskell-tng--hsinspect-as module))
+              (haskell-tng--import-symbol module as)
+              (save-excursion
+                (haskell-tng--hsinspect-beginning-of-symbol)
+                (insert as "."))))
+
+           ((eq class 'tycon)
+            (haskell-tng--import-symbol
+             module nil
+             (haskell-tng--hsinspect-return-type type)))
+
+           ((eq class 'con)
+            (haskell-tng--import-symbol
+             module nil
+             (concat (haskell-tng--hsinspect-return-type type) "(..)")))
+
+           (t (haskell-tng--import-symbol module nil name)))))
+      ;; FIXME update the hsinspect-imports cache
+      )))
 
 (defun haskell-tng--hsinspect-return-type (type)
   (car
@@ -176,17 +184,24 @@ When using hsinspect-0.0.8, also: class, export, flavour."
   "A `symbol-at-point' that includes FQN parts."
   (buffer-substring-no-properties
    (save-excursion
-     (while ;; WORKAROUND non-greedy matches
-         (re-search-backward
-          (rx symbol-start (+ (| word (syntax symbol) ".")) point)
-          (line-beginning-position)
-          'no-error))
-     (match-beginning 0))
+     (haskell-tng--hsinspect-beginning-of-symbol)
+     (point))
    (save-excursion
      (re-search-forward
       (rx point (+ (| word (syntax symbol) ".")) symbol-end)
-      (line-end-position) 'no-error)
-     (match-end 0))))
+      (line-end-position) 't)
+     (point))))
+
+(defun haskell-tng--hsinspect-beginning-of-symbol ()
+  (let ((lbp (line-beginning-position)))
+    ;; can't use `smie-backward-token-function' because we could be at the 
start,
+    ;; middle, or end.
+    (re-search-backward
+     (rx symbol-start (+ (| word (syntax symbol) ".")) point)
+     lbp 't)
+    ;; WORKAROUND non-greedy matches
+    (while (looking-back haskell-tng--rx-c-qual lbp 't)
+      (goto-char (match-beginning 0)))))
 
 (defun haskell-tng--hsinspect-ghcflags ()
   ;; https://github.com/haskell/cabal/issues/6203