emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Rewrite 'doom update'

Browse source 
- Is now much more fault tolerant (produces better errors)
- Now handles async.el process errors as well
- Standardizes data structure of thread responses
This commit is contained in:
Henrik Lissner 2019-07-29 21:01:46 +02:00
parent da954aa361
commit 87fd81281f
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 88 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

82
core/cli/packages.el
View file

@ -131,26 +131,16 @@ a list of packages that will be installed."
t)))) t))))
(defun doom-packages-update (&optional auto-accept-p) (defun doom--packages-remove-outdated-f (packages)
"Updates packages.
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
a list of packages that will be updated."
(print! (start "Scanning for outdated packages (this may take a while)..."))
(print-group!
;; REVIEW Does this fail gracefully enough? Is it error tolerant?
;; TODO Add version-lock checks; don't want to spend all this effort on
;; packages that shouldn't be updated
(let (futures)
(dolist (group (seq-partition (hash-table-values straight--repo-cache) 8))
(push
(async-start (async-start
`(lambda () `(lambda ()
(setq load-path ',load-path (setq load-path ',load-path
doom-modules ',doom-modules) doom-modules ',doom-modules)
(load ,(concat doom-core-dir "core.el")) (condition-case e
(let (packages errors) (let (packages errors)
(load ,(concat doom-core-dir "core.el"))
(dolist (recipe ',group) (dolist (recipe ',group)
(condition-case e
(straight--with-plist recipe (straight--with-plist recipe
(package local-repo remote upstream-repo upstream-host) (package local-repo remote upstream-repo upstream-host)
;; HACK There's a contingency of `straight-fetch-package' ;; HACK There's a contingency of `straight-fetch-package'
@ -169,7 +159,6 @@ a list of packages that will be updated."
(straight--get-call "git" "fetch" remote))) (straight--get-call "git" "fetch" remote)))
(straight-fetch-package package) (straight-fetch-package package)
;; REVIEW Is there no better way to get this information? ;; REVIEW Is there no better way to get this information?
(condition-case e
(let* ((default-directory (straight--repos-dir local-repo)) (let* ((default-directory (straight--repos-dir local-repo))
(n (string-to-number (n (string-to-number
(straight--get-call "git" "rev-list" "--right-only" "--count" "HEAD..@{u}"))) (straight--get-call "git" "rev-list" "--right-only" "--count" "HEAD..@{u}")))
@ -189,16 +178,37 @@ a list of packages that will be updated."
(erase-buffer))) (erase-buffer)))
(when (> n 0) (when (> n 0)
(push (list n pretime time recipe) (push (list n pretime time recipe)
packages))) packages)))))
(error (error
(push (cons package (string-trim (straight--process-get-output))) (push (list package e (string-trim (or (straight--process-get-output) "")))
errors)))))) errors))))
(cons errors (nreverse packages))))) (if errors
futures)) (cons 'error errors)
(condition-case e (cons 'ok (nreverse packages))))
(error
(cons 'error e))))))
(defun doom-packages-update (&optional auto-accept-p)
"Updates packages.
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
a list of packages that will be updated."
(print! (start "Scanning for outdated packages (this may take a while)..."))
(print-group!
;; REVIEW Does this fail gracefully enough? Is it error tolerant?
;; TODO Add version-lock checks; don't want to spend all this effort on
;; packages that shouldn't be updated
(let ((futures
(or (cl-loop for group
in (seq-partition (hash-table-values straight--repo-cache)
8)
if (doom--packages-remove-outdated-f group)
collect it)
(error! "Failed to create any threads"))))
(condition-case-unless-debug e
(let ((total (length futures)) (let ((total (length futures))
(futures (nreverse futures)) specs)
(specs '(t)))
(while futures (while futures
(print! ". %.0f%%" (* (/ (- total (length futures)) (print! ". %.0f%%" (* (/ (- total (length futures))
(float total)) (float total))
@ -206,18 +216,28 @@ a list of packages that will be updated."
(while (not (async-ready (car futures))) (while (not (async-ready (car futures)))
(sleep-for 2) (sleep-for 2)
(print! ".")) (print! "."))
(cl-destructuring-bind (errors . packages) (cl-destructuring-bind (status . result)
(async-get (pop futures)) (or (async-get (pop futures))
(if errors (cons nil nil))
(cond ((null status)
(error "Thread returned an invalid result: %S" errors result))
((eq status 'error)
(error "There were errors:\n\n%s" (error "There were errors:\n\n%s"
(if (and (listp result)
(symbolp (car result)))
(prin1-to-string result)
(mapconcat (lambda (e) (mapconcat (lambda (e)
(format! " - %s: %s" (yellow (car e)) (cdr e))) (format! " - %s: %s" (yellow (car e)) (cdr e)))
errors result
"\n") "\n"))))
errors) ((eq status 'ok)
(nconc specs packages)))) (print! (debug "Appended %S to package list") (or result "nothing"))
(appendq! specs result))
((error "Thread returned a non-standard status: %s\n\n%s"
status result)))))
(print! ". 100%%")
(terpri) (terpri)
(if-let (specs (delq nil (cdr specs))) (if-let (specs (delq nil specs))
(if (not (if (not
(or auto-accept-p (or auto-accept-p
(y-or-n-p (y-or-n-p