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

cli/packages: refactor doom-packages-update

Browse source 
- Now handles errors from threads gracefully, rather than failing
  silently.
- Exploits straights modification system to trigger rebuilds
  later (instead of force-rebuilding after each update).
This commit is contained in:
Henrik Lissner 2019-07-25 17:18:20 +02:00
parent a47351c58f
commit 2aa7dbfb27
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 65 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

63
core/cli/packages.el
View file

@ -127,21 +127,21 @@ a list of packages that will be updated."
;; REVIEW Does this fail gracefully enough? Is it error tolerant? ;; REVIEW Does this fail gracefully enough? Is it error tolerant?
;; TODO Add version-lock checks; don't want to spend all this effort on ;; TODO Add version-lock checks; don't want to spend all this effort on
;; packages that shouldn't be updated ;; packages that shouldn't be updated
(condition-case e
(let (futures) (let (futures)
(dolist (group (seq-partition (hash-table-values straight--repo-cache) 8)) (dolist (group (seq-partition (hash-table-values straight--repo-cache) 8))
(push (async-start (push
(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")) (load ,(concat doom-core-dir "core.el"))
(let (packages) (let (packages errors)
(when (require 'straight nil t)
(dolist (recipe ',group) (dolist (recipe ',group)
(straight--with-plist recipe (package local-repo) (straight--with-plist recipe (package local-repo remote)
(when (and local-repo (straight--repository-is-available-p recipe)) (when (and local-repo (straight--repository-is-available-p recipe))
(straight-fetch-package package) (straight-fetch-package package)
;; REVIEW Isn't there a better way to get this information? Maybe with `vc'? ;; 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
(shell-command-to-string "git rev-list --right-only --count HEAD..@'{u}'"))) (shell-command-to-string "git rev-list --right-only --count HEAD..@'{u}'")))
@ -151,11 +151,19 @@ a list of packages that will be updated."
(time (time
(string-to-number (string-to-number
(shell-command-to-string "git log -1 --format=%at FETCH_HEAD")))) (shell-command-to-string "git log -1 --format=%at FETCH_HEAD"))))
(with-current-buffer (straight--process-get-buffer)
(with-silent-modifications
(print! (debug (autofill "%s") (indent 2 (buffer-string))))
(erase-buffer)))
(when (> n 0) (when (> n 0)
(push (list n pretime time recipe) (push (list n pretime time recipe)
packages))))))) packages)))
(nreverse packages)))) (error
(push (cons package (string-trim (straight--process-get-output)))
errors))))))
(cons errors (nreverse packages)))))
futures)) futures))
(condition-case e
(let ((total (length futures)) (let ((total (length futures))
(futures (nreverse futures)) (futures (nreverse futures))
(specs '(t))) (specs '(t)))
@ -163,7 +171,16 @@ 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! "."))
(nconc specs (async-get (pop futures)))) (cl-destructuring-bind (errors . packages)
(async-get (pop futures))
(if errors
(error "There were errors:\n\n%s"
(mapconcat (lambda (e)
(format! " - %s: %s" (yellow (car e)) (cdr e)))
errors
"\n")
errors)
(nconc specs packages))))
(terpri) (terpri)
(if-let (specs (delq nil (cdr specs))) (if-let (specs (delq nil (cdr specs)))
(if (not (if (not
@ -186,32 +203,36 @@ a list of packages that will be updated."
(if (cdr specs) "s" ""))))) (if (cdr specs) "s" "")))))
(ignore (print! (info "Aborted update"))) (ignore (print! (info "Aborted update")))
(terpri) (terpri)
(straight--make-package-modifications-available)
(dolist (spec specs t) (dolist (spec specs t)
(cl-destructuring-bind (n pretime time recipe) spec (cl-destructuring-bind (n pretime time recipe) spec
(straight--with-plist recipe (local-repo package) (straight--with-plist recipe (local-repo package)
(let ((default-directory (straight--repos-dir local-repo))) (let ((default-directory (straight--repos-dir local-repo)))
(print! (start "Updating %S") package) (print! (start "Updating %S") package)
;; HACK `straight' doesn't assume it would ever be used ;; HACK `straight' assumes it won't be used in a
;; non-interactively, but here we are. If the repo is ;; noninteractive session, but here we are. If the repo
;; dirty, the command will lock up, waiting for ;; is dirty, the command will lock up, waiting for
;; interaction that will never come, so discard all local ;; interaction that will never come, so discard all
;; changes. Doom doesn't want you modifying those anyway. ;; local changes. Doom doesn't want you modifying those
;; anyway.
(and (straight--get-call "git" "reset" "--hard") (and (straight--get-call "git" "reset" "--hard")
(straight--get-call "git" "clean" "-ffd")) (straight--get-call "git" "clean" "-ffd"))
(straight-merge-package package) (straight-merge-package package)
;; HACK `straight-rebuild-package' doesn't pick up that ;; HACK `straight-rebuild-package' doesn't pick up
;; this package has changed, so we do it manually. Is ;; that this package has changed, so we do it
;; there a better way? ;; manually. Is there a better way?
(run-hook-with-args 'straight-use-package-pre-build-functions package) (straight-register-repo-modification local-repo)
(straight--build-package recipe " ")) (puthash local-repo t straight--cached-package-modifications)
(cl-incf n))
(with-current-buffer (straight--process-get-buffer) (with-current-buffer (straight--process-get-buffer)
(with-silent-modifications (with-silent-modifications
(print! (debug (autofill "%s") (indent 2 (buffer-string))))
(erase-buffer))))))) (erase-buffer)))))))
(print! (success "No packages to update")) (print! (success "No packages to update"))
nil))) nil))
(error (error
(message "Output:\n%s" (straight--process-get-output)) (message "Output:\n%s" (straight--process-get-output))
(signal (car e) (error-message-string e)))))) (signal (car e) (error-message-string e)))))))
(defun doom--packages-to-purge () (defun doom--packages-to-purge ()