Refactor package update logic
Still needs more work.
This commit is contained in:
Henrik Lissner
parent
1666ab3ddc
commit
dadd54604b
4 changed files with 145 additions and 131 deletions
|
|
@ -47,6 +47,7 @@
|
|||
deps))
|
||||
deps)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-depending-on (package &optional noerror)
|
||||
"Return a list of packages that depend on the package named NAME."
|
||||
(cl-check-type name symbol)
|
||||
|
|
@ -189,6 +190,34 @@ ones."
|
|||
(doom--read-module-packages-file private-packages all-p t))
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -59,29 +59,20 @@ list remains lean."
|
|||
;;
|
||||
;;; Library
|
||||
|
||||
(defun doom--straight-recipes ()
|
||||
(let (recipes)
|
||||
(dolist (recipe (hash-table-values straight--recipe-cache))
|
||||
(straight--with-plist recipe (local-repo type)
|
||||
(when (and local-repo (not (eq type 'built-in)))
|
||||
(push recipe recipes))))
|
||||
(nreverse recipes)))
|
||||
(defun doom--same-commit-p (abbrev-ref ref)
|
||||
(and (stringp abbrev-ref)
|
||||
(stringp ref)
|
||||
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
||||
ref)))
|
||||
|
||||
(defmacro doom--map-recipes (recipes binds &rest body)
|
||||
(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))))
|
||||
(defun doom--abbrev-commit (commit &optional full)
|
||||
(if full commit (substring commit 0 7)))
|
||||
|
||||
(defun doom--commit-log-between (start-ref end-ref)
|
||||
(and (straight--call
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
"-n" "25" end-ref (concat "^" (regexp-quote start-ref)))
|
||||
(straight--process-get-output)))
|
||||
|
||||
(defun doom-cli-packages-install ()
|
||||
"Installs missing packages.
|
||||
|
|
@ -92,7 +83,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(print! (start "Installing packages..."))
|
||||
(print-group!
|
||||
(if-let (built
|
||||
(doom--map-recipes (doom--straight-recipes)
|
||||
(doom-with-package-recipes (doom-package-recipe-list)
|
||||
(recipe package type local-repo)
|
||||
(condition-case-unless-debug e
|
||||
(progn
|
||||
|
|
@ -105,7 +96,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(if (straight-vc-commit-present-p recipe newcommit)
|
||||
(progn
|
||||
(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-rebuild-package package t))
|
||||
(ignore-errors
|
||||
|
|
@ -140,7 +131,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(unless force-p
|
||||
(straight--make-package-modifications-available))
|
||||
(if-let (built
|
||||
(doom--map-recipes (doom--straight-recipes) (package)
|
||||
(doom-with-package-recipes (doom-package-recipe-list) (package)
|
||||
(straight-use-package (intern package))))
|
||||
(print! (success "Rebuilt %d package(s)") (length built))
|
||||
(print! (success "No packages need rebuilding"))
|
||||
|
|
@ -152,101 +143,92 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(straight--transaction-finalize)
|
||||
(print! (start "Updating packages (this may take a while)..."))
|
||||
(let* ((straight--repos-dir (straight--repos-dir))
|
||||
(straight--packages-to-rebuild (make-hash-table :test 'equal))
|
||||
(updated-repos (make-hash-table :test 'equal))
|
||||
(recipes (doom--straight-recipes))
|
||||
(packages-to-rebuild (make-hash-table :test 'equal))
|
||||
(repos-to-rebuild (make-hash-table :test 'equal))
|
||||
(recipes (doom-package-recipe-list))
|
||||
(total (length recipes))
|
||||
(esc (if doom-debug-mode "" "\033[1A"))
|
||||
(i 0)
|
||||
errors)
|
||||
;; 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)
|
||||
(print-group!
|
||||
(unless (straight--repository-is-available-p recipe)
|
||||
(print! (error "(%d/%d) Couldn't find local repo for %s!")
|
||||
i total package)
|
||||
(print! (error "(%d/%d) Couldn't find local repo for %s!") i total package)
|
||||
(cl-return))
|
||||
(when (gethash local-repo updated-repos)
|
||||
(puthash package t straight--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)
|
||||
(when (gethash local-repo repos-to-rebuild)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "(%d/%d) %s was updated indirectly (with %s)") i total package local-repo)
|
||||
(cl-return))
|
||||
(let ((default-directory (straight--repos-dir local-repo))
|
||||
(esc (if doom-debug-mode "" "\033[1A")))
|
||||
(let ((default-directory (straight--repos-dir local-repo)))
|
||||
(unless (file-in-directory-p default-directory straight--repos-dir)
|
||||
(print! (warn "(%d/%d) Skipping %s because it is local")
|
||||
i total package)
|
||||
(print! (warn "(%d/%d) Skipping %s because it is local") i total package)
|
||||
(cl-return))
|
||||
;; FIXME Dear lord refactor me
|
||||
(condition-case-unless-debug e
|
||||
(let ((commit (straight-vc-get-commit type local-repo))
|
||||
(newcommit (cdr (assoc local-repo doom-pinned-packages))))
|
||||
(and (stringp newcommit)
|
||||
(string-match-p (concat "^" newcommit) commit)
|
||||
(print! (success "\033[K(%d/%d) %s is up-to-date...%s")
|
||||
i total package esc)
|
||||
(cl-return))
|
||||
(unless (or (and (stringp newcommit)
|
||||
(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))
|
||||
(let ((ref (straight-vc-get-commit type local-repo))
|
||||
(target-ref (cdr (assoc local-repo doom-pinned-packages)))
|
||||
output)
|
||||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
(print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(when (straight-vc-fetch-from-remote recipe)
|
||||
(setq output (straight--process-get-output))
|
||||
(straight-merge-package package)
|
||||
(setq newcommit (straight-vc-get-commit type local-repo)))
|
||||
(when (string-match-p (concat "^" newcommit) commit)
|
||||
(setq target-ref (straight-vc-get-commit type local-repo))
|
||||
(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))
|
||||
(print! (start "\033[K(%d/%d) Updating %s...%s") i total local-repo esc)
|
||||
(puthash local-repo t updated-repos)
|
||||
(puthash package t straight--packages-to-rebuild)
|
||||
(ignore-errors
|
||||
(delete-directory (straight--build-dir package) 'recursive))
|
||||
(print-group!
|
||||
|
||||
((straight-vc-commit-present-p recipe target-ref)
|
||||
(print! (start "\033[K(%d/%d) Checking out %s (%s)...%s")
|
||||
i total package (doom--abbrev-commit target-ref) esc)
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(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)
|
||||
(print! (info "%s") output))
|
||||
(when (eq type 'git)
|
||||
(straight--call
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
newcommit (concat "^" commit))
|
||||
(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))))
|
||||
(print-group! (print! (info "%s" output))))
|
||||
(print! (success "(%d/%d) %s updated (%s -> %s)")
|
||||
i total local-repo
|
||||
(doom--abbrev-commit ref)
|
||||
(doom--abbrev-commit target-ref)))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
(print! (warn "\033[K(%d/%d) Encountered error with %s" i total package))
|
||||
(print-group!
|
||||
(print! (error "%s" e))
|
||||
(print! (error "%s") e)
|
||||
(print-group! (print! (info "%s" (straight--process-get-output)))))
|
||||
(push package errors)))))
|
||||
(push package errors))))))
|
||||
(princ "\033[K")
|
||||
(when errors
|
||||
(print! (error "Encountered %d error(s), the offending packages: %s")
|
||||
(length errors) (string-join errors ", ")))
|
||||
(if (hash-table-empty-p straight--packages-to-rebuild)
|
||||
(ignore
|
||||
(print! (success "All %d packages are up-to-date")
|
||||
(hash-table-count straight--repo-cache)))
|
||||
(if (hash-table-empty-p packages-to-rebuild)
|
||||
(ignore (print! (success "All %d packages are up-to-date") total))
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(mapc (doom-rpartial #'delete-directory 'recursive)
|
||||
(hash-table-keys packages-to-rebuild)))
|
||||
(print! (success "Updated %d package(s)")
|
||||
(hash-table-count straight--packages-to-rebuild))
|
||||
(hash-table-count packages-to-rebuild))
|
||||
(doom-cli-packages-build)
|
||||
t))))
|
||||
t)))
|
||||
|
||||
|
||||
;;; PURGE (for the emperor)
|
||||
|
|
@ -267,10 +249,14 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(length
|
||||
(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)))
|
||||
(if (not (file-directory-p ".git"))
|
||||
(ignore (print! (warn "\033[Krepos/%s is not a git repo, skipping" repo)))
|
||||
(unless (file-directory-p ".git")
|
||||
(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)))
|
||||
(straight--call "git" "reset" "--hard")
|
||||
(straight--call "git" "clean" "-ffd")
|
||||
|
|
@ -279,7 +265,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(straight--call "git" "gc")
|
||||
(print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
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)))
|
||||
|
||||
(defun doom--cli-packages-regraft-repos (repos)
|
||||
|
|
|
|||
|
|
@ -130,7 +130,6 @@ missing) and shouldn't be deleted.")
|
|||
(append (apply orig-fn args) doom-pinned-packages))
|
||||
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrapper
|
||||
|
||||
|
|
|
|||
|
|
@ -448,7 +448,8 @@ unreadable. Returns the names of envvars that were changed."
|
|||
(point-max))))
|
||||
environment)))
|
||||
(when environment
|
||||
(setq process-environment
|
||||
(setq-default
|
||||
process-environment
|
||||
(append (nreverse environment) process-environment)
|
||||
exec-path
|
||||
(if (member "PATH" envvars)
|
||||
|
|
@ -531,11 +532,10 @@ to least)."
|
|||
(file-expand-wildcards (concat doom-core-dir "autoload/*.el")))
|
||||
|
||||
;; 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-cache-dir))
|
||||
(unless (file-directory-p dir)
|
||||
(make-directory dir 'parents)))
|
||||
|
||||
;; Ensure the package management system (and straight) are ready for
|
||||
;; action (and all core packages/repos are installed)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue