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

cli/packages: implement commit pinning support

Browse source 
This is step 2 toward version pinning and rollback.

Next step is to actually pin packages.

Step 1 was 125561eb0
This commit is contained in:
Henrik Lissner 2019-12-25 13:34:36 -05:00
parent 606d53cc47
commit 550c9bda74
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 79 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

86
core/cli/packages.el
View file

@ -57,6 +57,8 @@ list remains lean."
;; ;;
;;; Library ;;; Library
;; TODO Refactor all of me to be more functional!
(defun doom-cli-packages-install () (defun doom-cli-packages-install ()
"Installs missing packages. "Installs missing packages.
@ -64,15 +66,27 @@ This function will install any primary package (i.e. a package with a `package!'
declaration) or dependency thereof that hasn't already been." declaration) or dependency thereof that hasn't already been."
(print! (start "Installing & building packages...")) (print! (start "Installing & building packages..."))
(print-group! (print-group!
(let ((n 0)) (let ((versions-alist doom-pinned-packages)
(dolist (package (hash-table-keys straight--recipe-cache)) (n 0))
(straight--with-plist (gethash package straight--recipe-cache) (dolist (recipe (hash-table-values straight--recipe-cache))
(local-repo) (straight--with-plist recipe
(package local-repo)
(let ((existed-p (file-directory-p (straight--repos-dir package)))) (let ((existed-p (file-directory-p (straight--repos-dir package))))
(condition-case-unless-debug e (condition-case-unless-debug e
(and (straight-use-package (intern package) nil nil (make-string (1- (or doom-format-indent 1)) 32)) (and (straight-use-package
(intern package) nil nil
(make-string (1- (or doom-format-indent 1)) 32))
(not existed-p) (not existed-p)
(file-directory-p (straight--repos-dir package)) (file-directory-p (straight--repos-dir package))
(if-let (commit (cdr (assoc package versions-alist)))
(progn
(print! "Checking out %s commit %s"
package (substring commit 0 7))
(unless (straight-vc-commit-present-p recipe commit)
(straight-vc-fetch-from-remote recipe))
(straight-vc-check-out-commit recipe commit)
t)
t)
(cl-incf n)) (cl-incf n))
(error (error
(signal 'doom-package-error (signal 'doom-package-error
@ -136,54 +150,73 @@ declaration) or dependency thereof that hasn't already been."
(defun doom-cli-packages-update () (defun doom-cli-packages-update ()
"Updates packages." "Updates packages."
(print! (start "Updating packages (this may take a while)...")) (print! (start "Updating packages (this may take a while)..."))
;; TODO Refactor me
(let ((straight--repos-dir (straight--repos-dir)) (let ((straight--repos-dir (straight--repos-dir))
(straight--packages-to-rebuild (make-hash-table :test #'equal)) (straight--packages-to-rebuild (make-hash-table :test #'equal))
(total (hash-table-count straight--repo-cache)) (total (hash-table-count straight--repo-cache))
(versions-alist doom-pinned-packages)
(i 1) (i 1)
errors) errors)
;; TODO Log this somewhere?
(print-group! (print-group!
(dolist (recipe (hash-table-values straight--repo-cache)) (dolist (recipe (hash-table-values straight--repo-cache))
(catch 'skip
(straight--with-plist recipe (package type local-repo) (straight--with-plist recipe (package type local-repo)
(condition-case-unless-debug e (unless (straight--repository-is-available-p recipe)
(print! (error "(%d/%d) Couldn't find local repo for %s!")
i total package))
(let ((default-directory (straight--repos-dir local-repo))) (let ((default-directory (straight--repos-dir local-repo)))
(if (not (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)
(let ((commit (straight-vc-get-commit type local-repo))) (throw 'skip t))
(if (not (straight-vc-fetch-from-remote recipe)) (condition-case-unless-debug e
(let ((commit (straight-vc-get-commit type local-repo))
(newcommit (cdr (assoc package versions-alist)))
fetch-p)
(unless (or (and (stringp newcommit)
(straight-vc-commit-present-p recipe newcommit)
(print! (start "\033[K(%d/%d) Checking out %s for %s...\033[1A")
i total newcommit package))
(and (print! (start "\033[K(%d/%d) Fetching %s...\033[1A")
i total package)
(straight-vc-fetch-from-remote recipe)
(setq fetch t)))
(print! (warn "\033[K(%d/%d) Failed to fetch %s" i total package)) (print! (warn "\033[K(%d/%d) Failed to fetch %s" i total package))
(throw 'skip t))
(let ((output (straight--process-get-output))) (let ((output (straight--process-get-output)))
(if newcommit
(straight-vc-check-out-commit recipe newcommit)
(straight-merge-package package) (straight-merge-package package)
(let ((newcommit (straight-vc-get-commit type local-repo))) (setq newcommit (straight-vc-get-commit type local-repo)))
(if (string= commit newcommit) (when (string= commit newcommit)
(print! (start "\033[K(%d/%d) %s is up-to-date\033[1A") i total package) (throw 'skip t))
(print! (info "\033[K(%d/%d) Updating %s...") i total package)
(puthash package t straight--packages-to-rebuild)
(ignore-errors (ignore-errors
(delete-directory (straight--build-dir package) 'recursive)) (delete-directory (straight--build-dir package) 'recursive))
(puthash package t straight--packages-to-rebuild)
(print! (info "\033[K(%d/%d) Updating %s...") i total package)
(unless (string-empty-p output)
(print-group! (print-group!
(print! (info "%s") output) (unless (string-empty-p output)
(print! (info "%s") output))
(when (eq type 'git) (when (eq type 'git)
;; TODO Truncate long logs
(straight--call "git" "log" "--oneline" newcommit (concat "^" commit)) (straight--call "git" "log" "--oneline" newcommit (concat "^" commit))
(print-group! (print-group!
(print! "%s" (straight--process-get-output)))))) (print! "%s" (straight--process-get-output)))))
(print! (success "(%d/%d) %s updated (%s -> %s)") i total package (print! (success "(%d/%d) %s updated (%s -> %s)") i total package
(substring commit 0 7) (substring commit 0 7)
(substring newcommit 0 7)))))))) (substring newcommit 0 7))))
(cl-incf i))
(user-error (user-error
(signal 'user-error (error-message-string e))) (signal 'user-error (error-message-string e)))
(error (error
(print! (warn "(%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))))))
(cl-incf i))
(princ "\033[K") (princ "\033[K")
(when errors (when errors
(print! (error "There were %d errors, the offending packages are: %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 straight--packages-to-rebuild)
(ignore (ignore
@ -193,8 +226,9 @@ declaration) or dependency thereof that hasn't already been."
(packages (hash-table-keys straight--packages-to-rebuild))) (packages (hash-table-keys straight--packages-to-rebuild)))
(sort packages #'string-lessp) (sort packages #'string-lessp)
(doom--finalize-straight) (doom--finalize-straight)
(doom-cli-packages-build) (print! (success "Updated %d package(s): %s")
(print! (success "Updated %d package(s)") count)) count (string-join packages ", "))
(doom-cli-packages-build))
t)))) t))))