[nongnu] elpa/haskell-tng-mode 9359c7b 349/385: cl-loop

[ELPA Syncer]

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

    cl-loop
---
 haskell-tng-hsinspect.el | 157 +++++++++++++++++++++++------------------------
 1 file changed, 76 insertions(+), 81 deletions(-)

diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index e8c6120..8227d09 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -191,7 +191,8 @@ Respects the `C-u' cache invalidation convention."
         (setq sym (match-string 2 sym)))
 
       (let ((qual_ (car (rassoc qual haskell-tng-hsinspect-as))))
-        (if (haskell-tng--hsinspect-check-fqn-import index qual_ sym)
+        (if (when qual_
+              (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))
@@ -225,52 +226,51 @@ Respects the `C-u' cache invalidation convention."
 
 (defun haskell-tng--hsinspect-extract-imports (index module &optional as sym)
   "Calculates the imports from INDEX that are implied by MODULE AS and SYM."
-  ;; TODO a nested seq-mapcat threaded syntax
   (if sym
       `(((local . ,sym) (full . ,(concat module "." sym))))
-    (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)))
-                      (full (concat module "." id)))
-                 (if as
-                     `(((qual . ,(concat as "." id))
-                        (full . ,full)))
-                   `(((local . ,id)
-                      (full . ,full))))))
-             (alist-get 'ids module-entry))))
-        (alist-get 'modules pkg-entry)))
-     index)))
+    (cl-loop
+     for pkg-entry in index
+     append
+     (cl-loop
+      for module-entry in (alist-get 'modules pkg-entry)
+      when (equal module (alist-get 'module module-entry))
+      append
+      (cl-loop
+       for entry in (alist-get 'ids module-entry)
+       collect
+       (let* ((name (alist-get 'name entry))
+              (type (alist-get 'type entry))
+              (id (pcase (alist-get 'class entry)
+                    ((or 'id 'con 'pat) name)
+                    ('tycon type)))
+              (full (concat module "." id)))
+         (if as
+             `((qual . ,(concat as "." id))
+               (full . ,full))
+           `((local . ,id)
+             (full . ,full)))))))))
 
 (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)))
+  (block nested
+    (cl-loop
+     for pkg-entry in index
+     do
+     (cl-loop
+      for module-entry in (alist-get 'modules pkg-entry)
+      when (equal module (alist-get 'module module-entry))
+      do
+      (cl-loop
+       for entry in (alist-get 'ids module-entry)
+       do
+       (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)
+           (return-from nested
+             `(,(alist-get 'srcid pkg-entry))))))))))
 
 (defun haskell-tng--hsinspect-return-type (type)
   (car
@@ -298,18 +298,16 @@ Respects the `C-u' cache invalidation convention."
 nil if nothing was found.
 
 If SRCID is nil then the first matching MODULE is used."
-  ;; TODO seq-findmap as an alternative to (car (seq-mapcat ...)) or 
throw/catch
-  (catch 'found
-    (seq-do
-     (lambda (pkg-entry)
-       (when (or (null srcid) (equal srcid (alist-get 'srcid pkg-entry)))
-         (seq-do
-          (lambda (module-entry)
-            (when (equal module (alist-get 'module module-entry))
-              (throw 'found (cons pkg-entry module-entry))))
-          (alist-get 'modules pkg-entry))))
-     index)
-    nil))
+  (block nested
+    (cl-loop
+     for pkg-entry in index
+     when (or (null srcid) (equal srcid (alist-get 'srcid pkg-entry)))
+     do
+     (cl-loop
+      for module-entry in (alist-get 'modules pkg-entry)
+      when (equal module (alist-get 'module module-entry))
+      do
+      (return-from nested (cons pkg-entry module-entry))))))
 
 (defun haskell-tng--hsinspect-follow (index srcid module name)
   "Follow re-exports of MODULE to find where it was originally defined.
@@ -352,34 +350,31 @@ ability to follow any further."
   "Return an list of alists with keys: module, name, type.
 When using hsinspect-0.0.8, also: class, export, flavour.
 When using hsinspect-0.0.9, also: srcid."
-  ;; TODO threading/do syntax
-  ;; TODO alist variable binding like RecordWildcards
-  (seq-mapcat
-   (lambda (pkg-entry)
+  (cl-loop
+   for pkg-entry in index
+   append
+   (cl-loop
+    for module-entry in (alist-get 'modules pkg-entry)
+    append
+    (cl-loop
+     for entry in (alist-get 'ids module-entry)
+     append
      (let ((srcid (alist-get 'srcid pkg-entry))
-           (modules (alist-get 'modules pkg-entry)))
-       (seq-mapcat
-        (lambda (module-entry)
-          (let ((module (alist-get 'module module-entry))
-                (ids (alist-get 'ids module-entry)))
-            (seq-mapcat
-             (lambda (entry)
-               (let ((name (alist-get 'name entry))
-                     (type (alist-get 'type entry))
-                     (class (alist-get 'class entry))
-                     (export (alist-get 'export entry))
-                     (flavour (alist-get 'flavour entry)))
-                 (when (or (equal name sym) (equal type sym))
-                   `(((srcid . ,srcid)
-                      (module . ,module)
-                      (name . ,name)
-                      (type . ,type)
-                      (class . ,class)
-                      (export . ,export)
-                      (flavour . ,flavour))))))
-             ids)))
-        modules)))
-   index))
+           (module (alist-get 'module module-entry))
+           (name (alist-get 'name entry))
+           (type (alist-get 'type entry))
+           (class (alist-get 'class entry))
+           (export (alist-get 'export entry))
+           (flavour (alist-get 'flavour entry)))
+       ;; TODO alist variable binding like RecordWildcards
+       (when (or (equal name sym) (equal type sym))
+         `(((srcid . ,srcid)
+            (module . ,module)
+            (name . ,name)
+            (type . ,type)
+            (class . ,class)
+            (export . ,export)
+            (flavour . ,flavour)))))))))
 
 (defun haskell-tng--hsinspect-symbol-at-point ()
   "A `symbol-at-point' that includes FQN parts."