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

Implement BUNDLE-INSTALL with WITH-CONTEXT

parent 0baaec5a
...@@ -80,32 +80,25 @@ ...@@ -80,32 +80,25 @@
(defun bundle-install (&key clpmfile (validate (constantly t)) no-resolve) (defun bundle-install (&key clpmfile (validate (constantly t)) no-resolve)
"Given a clpmfile instance, install all releases from its lock file, creating "Given a clpmfile instance, install all releases from its lock file, creating
the lock file if necessary." the lock file if necessary."
(with-bundle-session (clpmfile) (with-clpm-session ()
(let* ((clpmfile (get-clpmfile clpmfile)) (with-context (lockfile (clpmfile-pathname clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile)) (let ((clpmfile (get-clpmfile clpmfile)))
(lockfile nil) (unless (config-value :local)
(changedp nil)) (dolist (s (context-sources clpmfile))
(unless (config-value :local) (unless (source-can-lazy-sync-p s)
(dolist (s (context-sources clpmfile)) (sync-source s))))
(unless (source-can-lazy-sync-p s) (if no-resolve
(sync-source s)))) (mapc #'install-release (context-releases lockfile))
(if (probe-file lockfile-pathname) (progn
(setf lockfile (load-lockfile lockfile-pathname)) ;; Nuke the lockfile's requirements so that we pick up deletions
(setf lockfile (create-empty-lockfile clpmfile))) ;; from the clpmfile.
(if no-resolve (setf (context-requirements lockfile) nil)
(mapc #'install-release (context-releases lockfile)) (setf (context-user-sources lockfile) (context-user-sources clpmfile))
(progn (setf lockfile (install-requirements (context-requirements clpmfile)
;; Nuke the lockfile's requirements so that we pick up deletions from the :context lockfile
;; clpmfile. :validate validate
(setf (context-requirements lockfile) nil) :update-projects (config-table-keys :bundle :local)
(setf lockfile (install-requirements (context-requirements clpmfile) :save-context-p t)))))
:context lockfile
:validate (lambda (diff)
(aprog1 (funcall validate diff)
(setf changedp it)))
:update-projects (config-table-keys :bundle :local)))
(when changedp
(save-context lockfile))))
lockfile))) lockfile)))
......
...@@ -158,7 +158,7 @@ can be named, global contexts, or anonymous.")) ...@@ -158,7 +158,7 @@ can be named, global contexts, or anonymous."))
(defun call-with-context (thunk context-designator) (defun call-with-context (thunk context-designator)
(if (context-anonymous-p context-designator) (if (context-anonymous-p context-designator)
(let* ((context-name context-designator) (let* ((context-name (context-name context-designator))
(*default-pathname-defaults* (uiop:pathname-directory-pathname context-name)) (*default-pathname-defaults* (uiop:pathname-directory-pathname context-name))
(*vcs-project-override-fun* (make-vcs-override-fun *default-pathname-defaults*))) (*vcs-project-override-fun* (make-vcs-override-fun *default-pathname-defaults*)))
(with-config-source (:pathname (merge-pathnames ".clpm/bundle.conf" (with-config-source (:pathname (merge-pathnames ".clpm/bundle.conf"
...@@ -346,8 +346,11 @@ in place with the same name. Return the new requirement if it was modified." ...@@ -346,8 +346,11 @@ in place with the same name. Return the new requirement if it was modified."
;; * Deserializing ;; * Deserializing
(defun load-anonymous-context-from-pathname (pn) (defun load-anonymous-context-from-pathname (pn)
(with-open-file (s pn) (if (probe-file pn)
(load-context-from-stream s pn))) (with-open-file (s pn)
(load-context-from-stream s pn))
(make-instance 'context
:name pn)))
(defun context-downselect-sources (name sources) (defun context-downselect-sources (name sources)
(let ((allowed-source-names (config-value :contexts name :sources))) (let ((allowed-source-names (config-value :contexts name :sources)))
......
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