Commit 05730014 authored by Eric Timmons's avatar Eric Timmons
Browse files

cli less work: bundle update

parent 676ee7b0
......@@ -5,18 +5,14 @@
(uiop:define-package #:clpm-cli/commands/bundle/update
(:use #:cl
#:clpm/bundle
#:clpm-cli/commands/bundle/common
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/context
#:clpm/log)
(:import-from #:adopt))
#:clpm-cli/interface-defs)
(:import-from #:adopt)
(:import-from #:clpm))
(in-package #:clpm-cli/commands/bundle/update)
(setup-logger)
(define-string *help-string*
"Update a bundle described in a clpmfile. Can either update the whole bundle
or a subset.
......@@ -44,8 +40,7 @@ preference is to update everything to the latest version possible.")
*option-yes*)))
(define-cli-command (("bundle" "update") *bundle-update-ui*) (args options)
(let* ((clpmfile-pathname (bundle-clpmfile-pathname))
(yesp (gethash :yes options)))
(bundle-update clpmfile-pathname :update-systems args
:validate (make-diff-validate-fun :yesp yesp))
(let ((yesp (gethash :yes options)))
(clpm:bundle-update :update-systems args
:validate (make-diff-validate-fun :yesp yesp))
t))
......@@ -163,41 +163,42 @@ the lock file if necessary."
:with-client with-client-p
:ignore-inherited t)))))
(defun bundle-update (clpmfile-designator &key
update-projects (validate (constantly t))
update-systems)
(let* ((*fetch-repo-automatically* (not (config-value :local)))
(clpmfile (get-clpmfile clpmfile-designator))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
(lockfile nil)
(changedp nil))
(unless (probe-file lockfile-pathname)
;; There is no lock file currently. Just fall back to BUNDLE-INSTALL.
(return-from bundle-update
(bundle-install :clpmfile clpmfile :validate validate)))
;; Load the existing lockfile
(setf lockfile (load-lockfile lockfile-pathname))
(unless (config-value :local)
(dolist (s (context-sources clpmfile))
(unless (source-can-lazy-sync-p s)
(sync-source s))))
;; Map all update systems to their projects.
(dolist (system update-systems)
(when-let* ((system-release (find system (context-system-releases lockfile)
:key (compose #'system-name #'system-release-system)
:test #'equal))
(release (system-release-release system-release))
(project-name (project-name (release-project release))))
(pushnew project-name update-projects :test #'equal)))
(setf lockfile (install-requirements (context-requirements clpmfile)
:context lockfile
:validate (lambda (diff)
(aprog1 (funcall validate diff)
(setf changedp it)))
:update-projects (or update-projects t)))
(when changedp
(save-context lockfile))))
(defun bundle-update (&key clpmfile
update-projects (validate (constantly t))
update-systems)
(with-bundle-session (clpmfile)
(let* ((*fetch-repo-automatically* (not (config-value :local)))
(clpmfile (get-clpmfile clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
(lockfile nil)
(changedp nil))
(unless (probe-file lockfile-pathname)
;; There is no lock file currently. Just fall back to BUNDLE-INSTALL.
(return-from bundle-update
(bundle-install :clpmfile clpmfile :validate validate)))
;; Load the existing lockfile
(setf lockfile (load-lockfile lockfile-pathname))
(unless (config-value :local)
(dolist (s (context-sources clpmfile))
(unless (source-can-lazy-sync-p s)
(sync-source s))))
;; Map all update systems to their projects.
(dolist (system update-systems)
(when-let* ((system-release (find system (context-system-releases lockfile)
:key (compose #'system-name #'system-release-system)
:test #'equal))
(release (system-release-release system-release))
(project-name (project-name (release-project release))))
(pushnew project-name update-projects :test #'equal)))
(setf lockfile (install-requirements (context-requirements clpmfile)
:context lockfile
:validate (lambda (diff)
(aprog1 (funcall validate diff)
(setf changedp it)))
:update-projects (or update-projects t)))
(when changedp
(save-context lockfile)))))
(defun bundle-exec (command args &key clpmfile
with-client-p)
......
......@@ -22,7 +22,8 @@
(:export #:bundle-exec
#:bundle-init
#:bundle-install
#:bundle-source-registry)
#:bundle-source-registry
#:bundle-update)
;; From client
(:export #:client-asd-pathname)
;; From config
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment