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

Fix bundle update and install

Requirements for VCS were getting resolved too early and some update arguments
were being ignored
parent 7b2dd4cc
......@@ -6,6 +6,7 @@
(uiop:define-package #:clpm/bundle
(:use #:cl
#:alexandria
#:anaphora
#:clpm/clpmfile
#:clpm/context
#:clpm/install
......@@ -52,18 +53,23 @@
the lock file if necessary."
(let* ((clpmfile (get-clpmfile clpmfile-designator))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile nil))
(lockfile nil)
(changedp nil))
(if (probe-file lockfile-pathname)
(setf lockfile (load-lockfile lockfile-pathname :localp localp))
(setf lockfile (create-empty-lockfile clpmfile)))
(unless localp
(mapc #'sync-source (clpmfile-sources clpmfile)))
(setf lockfile (install-requirements (clpmfile-all-requirements clpmfile)
:context lockfile :validate validate))
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream))))
:context lockfile
:validate (lambda (diff)
(aprog1 (funcall validate diff)
(setf changedp it)))))
(when changedp
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream)))))
(defun bundle-update (clpmfile-designator &key
update-projects (validate (constantly t))
......@@ -71,7 +77,8 @@ the lock file if necessary."
localp)
(let* ((clpmfile (get-clpmfile clpmfile-designator))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile nil))
(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
......@@ -89,9 +96,13 @@ the lock file if necessary."
(project-name (project-name (release-project release))))
(pushnew project-name update-projects :test #'equal)))
(setf lockfile (install-requirements (clpmfile-all-requirements clpmfile)
:context lockfile :validate validate
:update-projects update-projects))
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream))))
:context lockfile
:validate (lambda (diff)
(aprog1 (funcall validate diff)
(setf changedp it)))
:update-projects (or update-projects t)))
(when changedp
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream)))))
......@@ -47,7 +47,6 @@ preference is to update everything to the latest version possible.")
(defun make-validate-fun (yesp output)
(lambda (diff)
(format t "~S~%" (context-diff-to-plist diff))
(unless (equal output "sexp")
;; We can't print this in a sexp format at the moment.
(print-context-diff diff *standard-output*))
......
......@@ -406,10 +406,13 @@ in place with the same name. Return the new requirement if it was modified."
(defmethod process-form (context (section (eql :releases)) form)
(destructuring-bind (name &key version source systems) form
(declare (ignore systems))
(let ((source (get-source source)))
(push (source-project-release source name version)
(context-releases context)))))
(let* ((source (get-source source))
(release (source-project-release source name version)))
(push release
(context-releases context))
(dolist (system-name systems)
(push (release-system-release release system-name)
(context-system-releases context))))))
(defmethod process-form (context (section (eql :reverse-dependencies)) form))
......
......@@ -109,7 +109,6 @@ the requirements."
:unresolved-reqs reqs
:groveler (make-groveler)))
(final-node (perform-search root-node)))
(setf (context-requirements out-context) reqs)
(setf (context-releases out-context)
(mapcar #'car (node-activated-releases final-node)))
(setf (context-reverse-dependencies out-context)
......
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