Refactor package update logic

Still needs more work.
This commit is contained in:
Henrik Lissner 2020-01-26 21:21:06 -05:00
parent 1666ab3ddc
commit dadd54604b
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
4 changed files with 145 additions and 131 deletions

View file

@ -47,6 +47,7 @@
deps)) deps))
deps))) deps)))
;;;###autoload
(defun doom-package-depending-on (package &optional noerror) (defun doom-package-depending-on (package &optional noerror)
"Return a list of packages that depend on the package named NAME." "Return a list of packages that depend on the package named NAME."
(cl-check-type name symbol) (cl-check-type name symbol)
@ -189,6 +190,34 @@ ones."
(doom--read-module-packages-file private-packages all-p t)) (doom--read-module-packages-file private-packages all-p t))
(nreverse doom-packages))) (nreverse doom-packages)))
;;;###autoload
(defun doom-package-recipe-list ()
"Return straight recipes for non-builtin packages with a local-repo."
(let (recipes)
(dolist (recipe (hash-table-values straight--recipe-cache))
(with-plist! recipe (local-repo type)
(when (and local-repo (not (eq type 'built-in)))
(push recipe recipes))))
(nreverse recipes)))
;;;###autoload
(defmacro doom-with-package-recipes (recipes binds &rest body)
"TODO"
(declare (indent 2))
(let ((recipe-var (make-symbol "recipe"))
(recipes-var (make-symbol "recipes")))
`(let* ((,recipes-var ,recipes)
(built ())
(straight-use-package-pre-build-functions
(cons (lambda (pkg) (cl-pushnew pkg built :test #'equal))
straight-use-package-pre-build-functions)))
(dolist (,recipe-var ,recipes-var)
(cl-block nil
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
,(doom-enlist binds)
,@body)))
(nreverse built))))
;; ;;
;;; Main functions ;;; Main functions

View file

@ -59,29 +59,20 @@ list remains lean."
;; ;;
;;; Library ;;; Library
(defun doom--straight-recipes () (defun doom--same-commit-p (abbrev-ref ref)
(let (recipes) (and (stringp abbrev-ref)
(dolist (recipe (hash-table-values straight--recipe-cache)) (stringp ref)
(straight--with-plist recipe (local-repo type) (string-match-p (concat "^" (regexp-quote abbrev-ref))
(when (and local-repo (not (eq type 'built-in))) ref)))
(push recipe recipes))))
(nreverse recipes)))
(defmacro doom--map-recipes (recipes binds &rest body) (defun doom--abbrev-commit (commit &optional full)
(declare (indent 2)) (if full commit (substring commit 0 7)))
(let ((recipe-var (make-symbol "recipe"))
(recipes-var (make-symbol "recipes"))) (defun doom--commit-log-between (start-ref end-ref)
`(let* ((,recipes-var ,recipes) (and (straight--call
(built ()) "git" "log" "--oneline" "--no-merges"
(straight-use-package-pre-build-functions "-n" "25" end-ref (concat "^" (regexp-quote start-ref)))
(cons (lambda (pkg) (cl-pushnew pkg built :test #'equal)) (straight--process-get-output)))
straight-use-package-pre-build-functions)))
(dolist (,recipe-var ,recipes-var)
(cl-block nil
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
,(doom-enlist binds)
,@body)))
(nreverse built))))
(defun doom-cli-packages-install () (defun doom-cli-packages-install ()
"Installs missing packages. "Installs missing packages.
@ -92,7 +83,7 @@ declaration) or dependency thereof that hasn't already been."
(print! (start "Installing packages...")) (print! (start "Installing packages..."))
(print-group! (print-group!
(if-let (built (if-let (built
(doom--map-recipes (doom--straight-recipes) (doom-with-package-recipes (doom-package-recipe-list)
(recipe package type local-repo) (recipe package type local-repo)
(condition-case-unless-debug e (condition-case-unless-debug e
(progn (progn
@ -105,7 +96,7 @@ declaration) or dependency thereof that hasn't already been."
(if (straight-vc-commit-present-p recipe newcommit) (if (straight-vc-commit-present-p recipe newcommit)
(progn (progn
(print! (success "Checking out %s to %s") (print! (success "Checking out %s to %s")
package (substring newcommit 0 8)) package (doom--abbrev-commit newcommit))
(straight-vc-check-out-commit recipe newcommit) (straight-vc-check-out-commit recipe newcommit)
(straight-rebuild-package package t)) (straight-rebuild-package package t))
(ignore-errors (ignore-errors
@ -140,7 +131,7 @@ declaration) or dependency thereof that hasn't already been."
(unless force-p (unless force-p
(straight--make-package-modifications-available)) (straight--make-package-modifications-available))
(if-let (built (if-let (built
(doom--map-recipes (doom--straight-recipes) (package) (doom-with-package-recipes (doom-package-recipe-list) (package)
(straight-use-package (intern package)))) (straight-use-package (intern package))))
(print! (success "Rebuilt %d package(s)") (length built)) (print! (success "Rebuilt %d package(s)") (length built))
(print! (success "No packages need rebuilding")) (print! (success "No packages need rebuilding"))
@ -152,101 +143,92 @@ declaration) or dependency thereof that hasn't already been."
(straight--transaction-finalize) (straight--transaction-finalize)
(print! (start "Updating packages (this may take a while)...")) (print! (start "Updating packages (this may take a while)..."))
(let* ((straight--repos-dir (straight--repos-dir)) (let* ((straight--repos-dir (straight--repos-dir))
(straight--packages-to-rebuild (make-hash-table :test 'equal)) (packages-to-rebuild (make-hash-table :test 'equal))
(updated-repos (make-hash-table :test 'equal)) (repos-to-rebuild (make-hash-table :test 'equal))
(recipes (doom--straight-recipes)) (recipes (doom-package-recipe-list))
(total (length recipes)) (total (length recipes))
(esc (if doom-debug-mode "" "\033[1A"))
(i 0) (i 0)
errors) errors)
;; TODO Log this somewhere? ;; TODO Log this somewhere?
(doom--map-recipes recipes (recipe package type local-repo) (doom-with-package-recipes recipes (recipe package type local-repo)
(cl-incf i) (cl-incf i)
(print-group! (print-group!
(unless (straight--repository-is-available-p recipe) (unless (straight--repository-is-available-p recipe)
(print! (error "(%d/%d) Couldn't find local repo for %s!") (print! (error "(%d/%d) Couldn't find local repo for %s!") i total package)
i total package)
(cl-return)) (cl-return))
(when (gethash local-repo updated-repos) (when (gethash local-repo repos-to-rebuild)
(puthash package t straight--packages-to-rebuild) (puthash package t packages-to-rebuild)
(ignore-errors (delete-directory (straight--build-dir package) 'recursive)) (print! (success "(%d/%d) %s was updated indirectly (with %s)") i total package local-repo)
(print! (success "(%d/%d) %s was updated indirectly (with %s)")
i total package local-repo)
(cl-return)) (cl-return))
(let ((default-directory (straight--repos-dir local-repo)) (let ((default-directory (straight--repos-dir local-repo)))
(esc (if doom-debug-mode "" "\033[1A")))
(unless (file-in-directory-p default-directory straight--repos-dir) (unless (file-in-directory-p default-directory straight--repos-dir)
(print! (warn "(%d/%d) Skipping %s because it is local") (print! (warn "(%d/%d) Skipping %s because it is local") i total package)
i total package)
(cl-return)) (cl-return))
;; FIXME Dear lord refactor me
(condition-case-unless-debug e (condition-case-unless-debug e
(let ((commit (straight-vc-get-commit type local-repo)) (let ((ref (straight-vc-get-commit type local-repo))
(newcommit (cdr (assoc local-repo doom-pinned-packages)))) (target-ref (cdr (assoc local-repo doom-pinned-packages)))
(and (stringp newcommit) output)
(string-match-p (concat "^" newcommit) commit) (or (cond
(print! (success "\033[K(%d/%d) %s is up-to-date...%s") ((not (stringp target-ref))
i total package esc) (print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
(cl-return)) (when (straight-vc-fetch-from-remote recipe)
(unless (or (and (stringp newcommit) (setq output (straight--process-get-output))
(straight-vc-commit-present-p recipe newcommit)
(print! (start "\033[K(%d/%d) Checking out %s (%s)...%s")
i total package (substring newcommit 0 7) esc))
(and (print! (start "\033[K(%d/%d) Fetching %s...%s")
i total package esc)
(straight-vc-fetch-from-remote recipe)))
(print! (warn "\033[K(%d/%d) Failed to fetch %s")
i total (or local-repo package))
(cl-return))
(let ((output (straight--process-get-output)))
(if (stringp newcommit)
(if (straight-vc-commit-present-p recipe newcommit)
(straight-vc-check-out-commit recipe newcommit)
(print! (start "\033[K(%d/%d) Re-cloning %s...%s") i total local-repo esc)
(ignore-errors
(delete-directory (straight--repos-dir package) 'recursive))
(straight-use-package (intern package) nil 'no-build))
(straight-merge-package package) (straight-merge-package package)
(setq newcommit (straight-vc-get-commit type local-repo))) (setq target-ref (straight-vc-get-commit type local-repo))
(when (string-match-p (concat "^" newcommit) commit) (when (doom--same-commit-p target-ref ref)
(cl-return))))
((doom--same-commit-p target-ref ref)
(print! (success "\033[K(%d/%d) %s is up-to-date...%s") i total package esc)
(cl-return)) (cl-return))
(print! (start "\033[K(%d/%d) Updating %s...%s") i total local-repo esc)
(puthash local-repo t updated-repos) ((straight-vc-commit-present-p recipe target-ref)
(puthash package t straight--packages-to-rebuild) (print! (start "\033[K(%d/%d) Checking out %s (%s)...%s")
(ignore-errors i total package (doom--abbrev-commit target-ref) esc)
(delete-directory (straight--build-dir package) 'recursive)) (straight-vc-check-out-commit recipe target-ref)
(print-group! (or (not (eq type 'git))
(setq output (doom--commit-log-between ref target-ref)))
(doom--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
((print! (start "\033[K(%d/%d) Re-cloning %s...%s") i total local-repo esc)
(ignore-errors (delete-directory (straight--repos-dir package) 'recursive))
(straight-use-package (intern package) nil 'no-build)
(prog1 (file-directory-p (straight--repos-dir package))
(or (not (eq type 'git))
(setq output (doom--commit-log-between ref target-ref))))))
(progn
(print! (warn "\033[K(%d/%d) Failed to fetch %s") i total local-repo)
(cl-return)))
(puthash local-repo t repos-to-rebuild)
(puthash package t packages-to-rebuild)
(unless (string-empty-p output) (unless (string-empty-p output)
(print! (info "%s") output)) (print-group! (print! (info "%s" output))))
(when (eq type 'git) (print! (success "(%d/%d) %s updated (%s -> %s)")
(straight--call i total local-repo
"git" "log" "--oneline" "--no-merges" (doom--abbrev-commit ref)
newcommit (concat "^" commit)) (doom--abbrev-commit target-ref)))
(print-group!
(print! "%s" (straight--process-get-output)))))
(print! (success "(%d/%d) %s updated (%s -> %s)") i total
(or local-repo package)
(substring commit 0 7)
(substring newcommit 0 7))))
(user-error (user-error
(signal 'user-error (error-message-string e))) (signal 'user-error (error-message-string e)))
(error (error
(print! (warn "\033[K(%d/%d) Encountered error with %s" i total package)) (print! (warn "\033[K(%d/%d) Encountered error with %s" i total package))
(print-group! (print-group!
(print! (error "%s" e)) (print! (error "%s") e)
(print-group! (print! (info "%s" (straight--process-get-output))))) (print-group! (print! (info "%s" (straight--process-get-output)))))
(push package errors))))) (push package errors))))))
(princ "\033[K") (princ "\033[K")
(when errors (when errors
(print! (error "Encountered %d error(s), the offending packages: %s") (print! (error "Encountered %d error(s), the offending packages: %s")
(length errors) (string-join errors ", "))) (length errors) (string-join errors ", ")))
(if (hash-table-empty-p straight--packages-to-rebuild) (if (hash-table-empty-p packages-to-rebuild)
(ignore (ignore (print! (success "All %d packages are up-to-date") total))
(print! (success "All %d packages are up-to-date") (let ((default-directory (straight--build-dir)))
(hash-table-count straight--repo-cache))) (mapc (doom-rpartial #'delete-directory 'recursive)
(hash-table-keys packages-to-rebuild)))
(print! (success "Updated %d package(s)") (print! (success "Updated %d package(s)")
(hash-table-count straight--packages-to-rebuild)) (hash-table-count packages-to-rebuild))
(doom-cli-packages-build) (doom-cli-packages-build)
t)))) t)))
;;; PURGE (for the emperor) ;;; PURGE (for the emperor)
@ -267,10 +249,14 @@ declaration) or dependency thereof that hasn't already been."
(length (length
(delq nil (mapcar #'doom--cli-packages-purge-build builds)))))) (delq nil (mapcar #'doom--cli-packages-purge-build builds))))))
(defun doom--cli-packages-regraft-repo (repo) (cl-defun doom--cli-packages-regraft-repo (repo)
(let ((default-directory (straight--repos-dir repo))) (let ((default-directory (straight--repos-dir repo)))
(if (not (file-directory-p ".git")) (unless (file-directory-p ".git")
(ignore (print! (warn "\033[Krepos/%s is not a git repo, skipping" repo))) (print! (warn "\033[Krepos/%s is not a git repo, skipping" repo))
(cl-return))
(unless (file-in-directory-p default-directory straight-base-dir)
(print! (warn "\033[KSkipping repos/%s because it is local" repo))
(cl-return))
(let ((before-size (doom-directory-size default-directory))) (let ((before-size (doom-directory-size default-directory)))
(straight--call "git" "reset" "--hard") (straight--call "git" "reset" "--hard")
(straight--call "git" "clean" "-ffd") (straight--call "git" "clean" "-ffd")
@ -279,7 +265,7 @@ declaration) or dependency thereof that hasn't already been."
(straight--call "git" "gc") (straight--call "git" "gc")
(print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)") (print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
repo before-size (doom-directory-size default-directory)) repo before-size (doom-directory-size default-directory))
(print-group! (print! "%s" (straight--process-get-output))))) (print-group! (print! "%s" (straight--process-get-output))))
t))) t)))
(defun doom--cli-packages-regraft-repos (repos) (defun doom--cli-packages-regraft-repos (repos)

View file

@ -130,7 +130,6 @@ missing) and shouldn't be deleted.")
(append (apply orig-fn args) doom-pinned-packages)) (append (apply orig-fn args) doom-pinned-packages))
;; ;;
;;; Bootstrapper ;;; Bootstrapper

View file

@ -448,7 +448,8 @@ unreadable. Returns the names of envvars that were changed."
(point-max)))) (point-max))))
environment))) environment)))
(when environment (when environment
(setq process-environment (setq-default
process-environment
(append (nreverse environment) process-environment) (append (nreverse environment) process-environment)
exec-path exec-path
(if (member "PATH" envvars) (if (member "PATH" envvars)
@ -531,11 +532,10 @@ to least)."
(file-expand-wildcards (concat doom-core-dir "autoload/*.el"))) (file-expand-wildcards (concat doom-core-dir "autoload/*.el")))
;; Create all our core directories to quell file errors ;; Create all our core directories to quell file errors
(dolist (dir (list doom-local-dir (mapc (doom-rpartial #'make-directory 'parents)
(list doom-local-dir
doom-etc-dir doom-etc-dir
doom-cache-dir)) doom-cache-dir))
(unless (file-directory-p dir)
(make-directory dir 'parents)))
;; Ensure the package management system (and straight) are ready for ;; Ensure the package management system (and straight) are ready for
;; action (and all core packages/repos are installed) ;; action (and all core packages/repos are installed)