[nongnu] elpa/hyperdrive 08b24cd261: Change: (hyperdrive-mirror) Get metadata async and in parallel

[ELPA Syncer]

branch: elpa/hyperdrive
commit 08b24cd2612bf1a10a4d98220ce5f3421448cbb0
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Change: (hyperdrive-mirror) Get metadata async and in parallel
    
    Also:
    
    1. Show progress indicator while doing so.
    
    2. Reorder hyperdrive-mirror buffer's columns and using clearer status
       descriptions.
---
 hyperdrive-mirror.el | 118 +++++++++++++++++++++++++++++++--------------------
 1 file changed, 72 insertions(+), 46 deletions(-)

diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 1278ddfba8..809507a163 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -48,8 +48,8 @@
 FILES-AND-URLS is structured like `tabulated-list-entries'.  After
 uploading files, open PARENT-ENTRY."
   (let* ((count 0)
-         (upload-files-and-urls (cl-remove-if-not (pcase-lambda (`(,_id 
[,status ,_file ,_url]))
-                                                    (string-match-p (rx (or 
"new" "newer")) status))
+         (upload-files-and-urls (cl-remove-if-not (pcase-lambda (`(,_id 
[,_file ,status ,_url]))
+                                                    (string-match-p (rx (or 
"not in" "newer than")) status))
                                                   files-and-urls))
          (progress-reporter
           (make-progress-reporter (format "Uploading %s files: " (length 
upload-files-and-urls)) 0 (length upload-files-and-urls)))
@@ -62,7 +62,7 @@ uploading files, open PARENT-ENTRY."
                               (revert-buffer nil t))))))
     (unless upload-files-and-urls
       (hyperdrive-user-error "No new/newer files to upload"))
-    (pcase-dolist (`(,_id [,_status ,file ,url]) upload-files-and-urls)
+    (pcase-dolist (`(,_id [,file ,_status ,url]) upload-files-and-urls)
       (hyperdrive-upload-file file (hyperdrive-url-entry url)
         :queue queue
         ;; TODO: Error handling (e.g. in case one or more files fails to 
upload).
@@ -140,56 +140,82 @@ predicate and set NO-CONFIRM to t."
                         (string-match-p regexp filename)))))
   (let* ((files (cl-remove-if-not predicate (directory-files-recursively 
source ".")))
          (parent-entry (hyperdrive-entry-create :hyperdrive hyperdrive :path 
target-dir :encode t))
-         (files-and-urls
-          ;; Structured according to `tabulated-list-entries'
-          (mapcar (lambda (file)
-                    (let* ((entry (hyperdrive-entry-create
-                                   :hyperdrive hyperdrive
-                                   :path (expand-file-name (file-relative-name 
file source) target-dir)
-                                   :encode t))
-                           (status-no-properties
-                            (condition-case err
-                                (let ((drive-mtime (hyperdrive-entry-mtime 
(hyperdrive-fill entry :then 'sync)))
-                                      (local-mtime 
(file-attribute-modification-time (file-attributes file))))
-                                  (cond
-                                   ((time-equal-p drive-mtime local-mtime) 
"same")
-                                   ((time-less-p drive-mtime local-mtime) 
"newer")
-                                   (t "older")))
-                              (plz-error
-                               (pcase (caddr err)
-                                 ((app plz-error-response (cl-struct 
plz-response (status 404)))
-                                  ;; Entry doesn't exist: Set `status' to 
`new'.
-                                  (hyperdrive-update-nonexistent-version-range 
entry)
-                                  "new")
-                                 (_
-                                  ;; Re-signal error.
-                                  (signal (car err) (cdr err)))))))
-                           (status
-                            (propertize (format "%-7s" status-no-properties)
-                                        'face (pcase-exhaustive 
status-no-properties
-                                                ("new" 'hyperdrive-mirror-new)
-                                                ("newer" 
'hyperdrive-mirror-newer)
-                                                ("older" 
'hyperdrive-mirror-older)
-                                                ("same" 
'hyperdrive-mirror-same))))
-                           (url (hyperdrive-entry-url entry)))
-                      (list url (vector status file url))))
-                  files)))
+         (buffer (unless no-confirm
+                   (get-buffer-create "*hyperdrive-mirror*")))
+         (num-filled 0)
+         (num-of (length files))
+         metadata-queue files-and-urls)
     (unless files
       (hyperdrive-user-error "No files selected for mirroring (double-check 
predicate)"))
     (if no-confirm
         (hyperdrive--mirror files-and-urls parent-entry)
-      (pop-to-buffer (get-buffer-create "*hyperdrive-mirror*"))
-      (hyperdrive-mirror-mode)
-      (setq-local hyperdrive-mirror-query
-                  `(,source ,hyperdrive :target-dir ,target-dir :predicate 
,predicate))
-      (setq-local hyperdrive-mirror-parent-entry parent-entry)
-      (setf tabulated-list-entries files-and-urls)
-      (tabulated-list-print))))
+      (with-current-buffer buffer
+        (with-silent-modifications
+          (cl-labels ((update-progress (num-filled num-of)
+                        (when (zerop (mod num-filled 5))
+                          (with-current-buffer buffer
+                            (with-silent-modifications
+                              (erase-buffer)
+                              (insert (propertize (format "Comparing files 
(%s/%s)..." num-filled num-of)
+                                                  'face 
'font-lock-comment-face)))))))
+            (hyperdrive-mirror-mode)
+            (setq-local hyperdrive-mirror-query
+                        `(,source ,hyperdrive :target-dir ,target-dir 
:predicate ,predicate)
+                        hyperdrive-mirror-parent-entry parent-entry)
+            (setf metadata-queue (make-plz-queue
+                                  :limit hyperdrive-queue-size
+                                  :finally (lambda ()
+                                             (with-current-buffer buffer
+                                               (with-silent-modifications
+                                                 (erase-buffer)
+                                                 (setf tabulated-list-entries
+                                                       (sort files-and-urls
+                                                             (pcase-lambda 
(`(,_ [,_ ,a-file ,_]) `(,_ [,_ ,b-file ,_]))
+                                                               (string< a-file 
b-file))))
+                                                 (tabulated-list-print))
+                                               (set-buffer-modified-p nil)))))
+            (dolist (file files)
+              (let ((entry (hyperdrive-entry-create
+                            :hyperdrive hyperdrive
+                            :path (expand-file-name (file-relative-name file 
source) target-dir)
+                            :encode t)))
+                (hyperdrive-fill entry :queue metadata-queue
+                  :then (lambda (entry)
+                          (let* ((drive-mtime (hyperdrive-entry-mtime entry))
+                                 (local-mtime 
(file-attribute-modification-time (file-attributes file)))
+                                 (status (cond
+                                          ((time-equal-p drive-mtime 
local-mtime)
+                                           (propertize "same as" 'face 
'hyperdrive-mirror-same))
+                                          ((time-less-p drive-mtime 
local-mtime)
+                                           (propertize "newer than" 'face 
'hyperdrive-mirror-newer))
+                                          (t
+                                           (propertize "older than" 'face 
'hyperdrive-mirror-older))))
+                                 (url (hyperdrive-entry-url entry)))
+                            (push (list url (vector file status url)) 
files-and-urls)
+                            (update-progress (cl-incf num-filled) num-of)))
+                  :else (lambda (plz-error)
+                          (let ((status-code (plz-response-status 
(plz-error-response plz-error))))
+                            (pcase status-code
+                              (404 ;; Entry doesn't exist: Set `status' to 
`new'.
+                               ;; TODO: Consider moving 
`hyperdrive-update-nonexistent-version-range' call...
+                               (hyperdrive-update-nonexistent-version-range 
entry)
+                               (let ((status (propertize "not in" 'face 
'hyperdrive-mirror-new))
+                                     (url (hyperdrive-entry-url entry)))
+                                 (push (list url (vector file status url)) 
files-and-urls)
+                                 (update-progress (cl-incf num-filled) 
num-of)))
+                              (_
+                               (hyperdrive-error "Unable to get metadata for 
URL \"%s\": %S"
+                                                 (hyperdrive-entry-url entry) 
plz-error))))))))
+            (pop-to-buffer (current-buffer))))))))
 
 (defun hyperdrive-mirror-do-upload ()
   "Upload files in current \"*hyperdrive-mirror*\" buffer."
   (declare (modes hyperdrive-mirror-mode))
   (interactive)
+  ;; FIXME: Debounce this (e.g. if the user accidentally calls this
+  ;; command twice in a mirror buffer, it would start another queue to
+  ;; upload the same files, which would unnecessarily increment the
+  ;; hyperdrive version by potentially a lot).
   (if (and tabulated-list-entries hyperdrive-mirror-parent-entry)
       (hyperdrive--mirror tabulated-list-entries 
hyperdrive-mirror-parent-entry)
     (hyperdrive-user-error "Missing information about files to upload.  Are 
you in a \"*hyperdrive-mirror*\" buffer?")))
@@ -207,8 +233,8 @@ predicate and set NO-CONFIRM to t."
   :group 'hyperdrive
   :interactive nil
   ;; TODO: When possible, use vtable.el (currently only available in Emacs 
>=29) (or maybe taxy-magit-section)
-  (setq tabulated-list-format [("Status" 7 t)
-                               ("From file" 60 t)
+  (setq tabulated-list-format [("From file" 60 t)
+                               ("Status" 10 t)
                                ("To URL" 60 t)]
         revert-buffer-function #'hyperdrive-mirror-revert-buffer)
   (tabulated-list-init-header))