Commit 71972b91 authored by Eric Timmons's avatar Eric Timmons
Browse files

cli less work: update

parent 68660779
...@@ -6,18 +6,12 @@ ...@@ -6,18 +6,12 @@
(uiop:define-package #:clpm-cli/commands/update (uiop:define-package #:clpm-cli/commands/update
(:use #:cl (:use #:cl
#:clpm-cli/common-args #:clpm-cli/common-args
#:clpm-cli/interface-defs #:clpm-cli/interface-defs)
#:clpm/config (:import-from #:adopt)
#:clpm/context (:import-from #:clpm))
#:clpm/install
#:clpm/log
#:clpm/update)
(:import-from #:adopt))
(in-package #:clpm-cli/commands/update) (in-package #:clpm-cli/commands/update)
(setup-logger)
(defparameter *option-update-yes* (defparameter *option-update-yes*
(adopt:make-option (adopt:make-option
:update-yes :update-yes
...@@ -49,10 +43,8 @@ ...@@ -49,10 +43,8 @@
(define-cli-command (("update") *update-ui*) (args options) (define-cli-command (("update") *update-ui*) (args options)
(let ((system-names args) (let ((system-names args)
(project-names (gethash :update-projects options)) (project-names (gethash :update-projects options))
(context-name (config-value :context))
(yes-p (gethash :update-yes options))) (yes-p (gethash :update-yes options)))
(update :validate (make-diff-validate-fun :yesp yes-p) (clpm:update :validate (make-diff-validate-fun :yesp yes-p)
:context context-name :update-systems system-names
:update-systems system-names :update-projects project-names)
:update-projects project-names)
t)) t))
...@@ -7,12 +7,18 @@ ...@@ -7,12 +7,18 @@
(:nicknames #:clpm) (:nicknames #:clpm)
(:use #:cl (:use #:cl
#:clpm/bundle #:clpm/bundle
#:clpm/config
#:clpm/context #:clpm/context
#:clpm/context-diff #:clpm/context-diff
#:clpm/install #:clpm/install
#:clpm/source #:clpm/source
#:clpm/update
#:clpm/version) #:clpm/version)
(:export #:install) (:export #:install)
;; From config
(:export #:config-value)
;; From update
(:export #:update)
;; From version ;; From version
(:export #:clpm-version)) (:export #:clpm-version))
......
...@@ -11,6 +11,7 @@ ...@@ -11,6 +11,7 @@
#:clpm/install/defs #:clpm/install/defs
#:clpm/log #:clpm/log
#:clpm/resolve #:clpm/resolve
#:clpm/session
#:clpm/source) #:clpm/source)
(:export #:update)) (:export #:update))
...@@ -21,21 +22,22 @@ ...@@ -21,21 +22,22 @@
(defun update (&key update-projects update-systems (defun update (&key update-projects update-systems
(validate (constantly t)) (validate (constantly t))
context) context)
(let* ((orig-context (get-context context)) (with-clpm-session ()
(context (copy-context orig-context))) (let* ((orig-context (get-context context))
;; Map all systems to their corresponding projects. (context (copy-context orig-context)))
(dolist (system update-systems) ;; Map all systems to their corresponding projects.
(when-let* ((system-release (find system (context-system-releases orig-context) (dolist (system update-systems)
:key (compose #'system-name #'system-release-system) (when-let* ((system-release (find system (context-system-releases orig-context)
:test #'equal)) :key (compose #'system-name #'system-release-system)
(release (system-release-release system-release)) :test #'equal))
(project-name (project-name (release-project release)))) (release (system-release-release system-release))
(pushnew project-name update-projects :test #'equal))) (project-name (project-name (release-project release))))
(pushnew project-name update-projects :test #'equal)))
(log:info "Updating ~:[all~;~:*~{~A~^, ~}~] projects." update-projects) (log:info "Updating ~:[all~;~:*~{~A~^, ~}~] projects." update-projects)
(let* ((new-context (resolve-requirements context :update-projects (or update-projects t))) (let* ((new-context (resolve-requirements context :update-projects (or update-projects t)))
(diff (make-context-diff orig-context new-context))) (diff (make-context-diff orig-context new-context)))
(when (funcall validate diff) (when (funcall validate diff)
(mapc #'install-release (context-releases new-context)) (mapc #'install-release (context-releases new-context))
(context-write-asdf-files new-context) (context-write-asdf-files new-context)
(save-context new-context))))) (save-context new-context))))))
Supports Markdown
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