emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/haskell-tng-mode 4f84cde 347/385: improve importing qualif


From: ELPA Syncer
Subject: [nongnu] elpa/haskell-tng-mode 4f84cde 347/385: improve importing qualified symbols
Date: Wed, 6 Oct 2021 00:00:02 -0400 (EDT)

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

    improve importing qualified symbols
---
 haskell-tng-hsinspect.el | 87 ++++++++++++++++++++++++++++++++----------------
 haskell-tng-util.el      | 26 ++++++++-------
 2 files changed, 72 insertions(+), 41 deletions(-)

diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 02080d5..ee0e086 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -135,7 +135,11 @@ definition of the symbol in the build tool's source 
archive."
   '(("Data.Aeson" . "Json")
     ("Data.List" . "L")
     ("Data.List.NonEmpty" . "NE")
-    ("Data.Map.String" . "M")
+    ("Data.List.NonEmpty" . "NEL")
+    ("Data.Set" . "S")
+    ("Data.Set" . "Set")
+    ("Data.Map.Strict" . "M")
+    ("Data.Map.Strict" . "Map")
     ("Data.ByteString" . "BS")
     ("Data.ByteString.Lazy" . "LBS")
     ("Data.Text" . "T"))
@@ -177,34 +181,37 @@ Respects the `C-u' cache invalidation convention."
         (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--hsinspect-import-symbol index module qual))
-
-           ((xor haskell-tng-hsinspect-qualify (eq '- alt))
-            (when-let (as (haskell-tng--hsinspect-as module))
-              (haskell-tng--hsinspect-import-symbol index module as)
-              (save-excursion
-                (haskell-tng--hsinspect-beginning-of-symbol)
-                (insert as "."))))
-
-           ((eq class 'tycon)
-            (haskell-tng--hsinspect-import-symbol
-             index
-             module nil
-             (haskell-tng--hsinspect-return-type type)))
-
-           ((eq class 'con)
-            (haskell-tng--hsinspect-import-symbol
-             index
-             module nil
-             (concat (haskell-tng--hsinspect-return-type type) "(..)")))
-
-           (t (haskell-tng--hsinspect-import-symbol index module nil name)))))
+      (let ((qual_ (car (rassoc qual haskell-tng-hsinspect-as))))
+        (if (haskell-tng--hsinspect-check-fqn-import index qual_ sym)
+            (haskell-tng--hsinspect-import-symbol index qual_ qual)
+          (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--hsinspect-import-symbol index module qual))
+
+               ((xor haskell-tng-hsinspect-qualify (eq '- alt))
+                (when-let (as (haskell-tng--hsinspect-as module))
+                  (haskell-tng--hsinspect-import-symbol index module as)
+                  (save-excursion
+                    (haskell-tng--hsinspect-beginning-of-symbol)
+                    (insert as "."))))
+
+               ((eq class 'tycon)
+                (haskell-tng--hsinspect-import-symbol
+                 index
+                 module nil
+                 (haskell-tng--hsinspect-return-type type)))
+
+               ((eq class 'con)
+                (haskell-tng--hsinspect-import-symbol
+                 index
+                 module nil
+                 (concat (haskell-tng--hsinspect-return-type type) "(..)")))
+
+               (t (haskell-tng--hsinspect-import-symbol index module nil 
name)))))))
       )))
 
 (defun haskell-tng--hsinspect-extract-imports (index module &optional as sym)
@@ -234,6 +241,28 @@ Respects the `C-u' cache invalidation convention."
         (alist-get 'modules pkg-entry)))
      index)))
 
+(defun haskell-tng--hsinspect-check-fqn-import (index module sym)
+  "Checks if an FQN exists"
+  ;; TODO a nested seq-mapcat threaded syntax
+  (when module
+    (seq-mapcat
+     (lambda (pkg-entry)
+       (seq-mapcat
+        (lambda (module-entry)
+          (when (equal module (alist-get 'module module-entry))
+            (seq-mapcat
+             (lambda (entry)
+               (let* ((name (alist-get 'name entry))
+                      (type (alist-get 'type entry))
+                      (id (pcase (alist-get 'class entry)
+                            ((or 'id 'con 'pat) name)
+                            ('tycon type))))
+                 (when (equal sym id)
+                   `((,(alist-get 'srcid pkg-entry))))))
+             (alist-get 'ids module-entry))))
+        (alist-get 'modules pkg-entry)))
+     index)))
+
 (defun haskell-tng--hsinspect-return-type (type)
   (car
    (split-string
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 32a591a..02fc271 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -82,18 +82,20 @@ and taking a regexp."
       (re-search-forward (rx line-start "module" word-end))
       (forward-line 1)
       (insert "\n"))
-    (insert
-     "import "
-     (cond
-      ((and (null as) (null sym))
-       module)
-      ((null as)
-       (concat module " (" sym ")"))
-      ((eq t as)
-       (concat "qualified " module))
-      (t
-       (concat "qualified " module " as " as)))
-     "\n")))
+    (let ((beg (point)))
+      (insert
+       "import "
+       (cond
+        ((and (null as) (null sym))
+         module)
+        ((null as)
+         (concat module " (" sym ")"))
+        ((eq t as)
+         (concat "qualified " module))
+        (t
+         (concat "qualified " module " as " as)))
+       "\n")
+      (message "Inserted `%s'" (string-trim (buffer-substring-no-properties 
beg (point)))))))
 
 ;; TODO needs a unit test
 (defun haskell-tng--util-cached



reply via email to

[Prev in Thread] Current Thread [Next in Thread]