Commit 676ee7b0 authored by Eric Timmons's avatar Eric Timmons
Browse files

cli less work: bundle source-registry

parent eb224c65
......@@ -5,18 +5,14 @@
(uiop:define-package #:clpm-cli/commands/bundle/source-registry
(:use #:cl
#:clpm/bundle
#:clpm-cli/commands/bundle/common
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/clpmfile
#:clpm/log)
(:import-from #:adopt))
#:clpm-cli/interface-defs)
(:import-from #:adopt)
(:import-from #:clpm))
(in-package #:clpm-cli/commands/bundle/source-registry)
(setup-logger)
(defparameter *option-with-client*
(adopt:make-option
:bundle-exec-with-client
......@@ -36,8 +32,9 @@
(define-cli-command (("bundle" "source-registry") *bundle-source-registry-ui*) (args options)
(declare (ignore args))
(let* ((clpmfile-pathname (bundle-clpmfile-pathname))
(include-client-p (gethash :bundle-exec-with-client options))
(cl-source-registry-form (bundle-source-registry clpmfile-pathname :include-client-p include-client-p)))
(format t "~S~%" cl-source-registry-form)
t))
(with-standard-io-syntax
(let ((*print-case* :downcase)
(source-registry-form
(clpm:bundle-source-registry :with-client-p (gethash :bundle-exec-with-client options))))
(format t "~S~%" source-registry-form)))
t)
......@@ -142,28 +142,26 @@ the lock file if necessary."
lockfile)))
(defun bundle-source-registry (clpmfile-designator
&key include-client-p ignore-missing-releases)
(with-sources-using-installed-only ()
(let* ((*fetch-repo-automatically* nil)
(clpmfile (get-clpmfile clpmfile-designator))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
lockfile)
(unless (probe-file lockfile-pathname)
(error "Lockfile ~A does not exist" lockfile-pathname))
(setf lockfile (load-lockfile lockfile-pathname))
(unless ignore-missing-releases
(let* ((releases (context-releases lockfile))
(missing-releases (remove-if #'release-installed-p releases)))
(when missing-releases
(error "The following releases are not installed: ~{~S~^, ~}"
(mapcar (compose #'project-name #'release-project) missing-releases)))))
(context-to-asdf-source-registry-form
lockfile
:extra-forms
(when include-client-p
`((:directory ,(uiop:pathname-directory-pathname (client-asd-pathname)))))))))
(defun bundle-source-registry (&key clpmfile with-client-p ignore-missing-releases)
(with-bundle-session (clpmfile)
(with-sources-using-installed-only ()
(let* ((*fetch-repo-automatically* nil)
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
lockfile)
(unless (probe-file lockfile-pathname)
(error "Lockfile ~A does not exist" lockfile-pathname))
(setf lockfile (load-lockfile lockfile-pathname))
(unless ignore-missing-releases
(let* ((releases (context-releases lockfile))
(missing-releases (remove-if #'release-installed-p releases)))
(when missing-releases
(error "The following releases are not installed: ~{~S~^, ~}"
(mapcar (compose #'project-name #'release-project) missing-releases)))))
(context-to-asdf-source-registry-form
lockfile
:with-client with-client-p
:ignore-inherited t)))))
(defun bundle-update (clpmfile-designator &key
update-projects (validate (constantly t))
......@@ -219,7 +217,8 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile (load-lockfile lockfile-pathname))
(cl-source-registry-form (context-to-asdf-source-registry-form lockfile
:with-client with-client-p))
:with-client with-client-p
:ignore-inherited t))
(output-translations (context-output-translations lockfile))
(installed-system-names (sort (mapcar #'system-name (context-installed-systems lockfile)) #'string<))
(visible-primary-system-names (sort (context-visible-primary-system-names lockfile) #'string<)))
......
......@@ -21,7 +21,8 @@
;; From bundle
(:export #:bundle-exec
#:bundle-init
#:bundle-install)
#:bundle-install
#:bundle-source-registry)
;; 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