Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpm
Commits
71972b91
Commit
71972b91
authored
May 18, 2020
by
Eric Timmons
Browse files
cli less work: update
parent
68660779
Changes
3
Hide whitespace changes
Inline
Side-by-side
cli/commands/update.lisp
View file @
71972b91
...
...
@@ -6,18 +6,12 @@
(
uiop:define-package
#:clpm-cli/commands/update
(
:use
#:cl
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/config
#:clpm/context
#:clpm/install
#:clpm/log
#:clpm/update
)
(
:import-from
#:adopt
))
#:clpm-cli/interface-defs
)
(
:import-from
#:adopt
)
(
:import-from
#:clpm
))
(
in-package
#:clpm-cli/commands/update
)
(
setup-logger
)
(
defparameter
*option-update-yes*
(
adopt:make-option
:update-yes
...
...
@@ -49,10 +43,8 @@
(
define-cli-command
((
"update"
)
*update-ui*
)
(
args
options
)
(
let
((
system-names
args
)
(
project-names
(
gethash
:update-projects
options
))
(
context-name
(
config-value
:context
))
(
yes-p
(
gethash
:update-yes
options
)))
(
update
:validate
(
make-diff-validate-fun
:yesp
yes-p
)
:context
context-name
:update-systems
system-names
:update-projects
project-names
)
(
clpm:update
:validate
(
make-diff-validate-fun
:yesp
yes-p
)
:update-systems
system-names
:update-projects
project-names
)
t
))
clpm/clpm.lisp
View file @
71972b91
...
...
@@ -7,12 +7,18 @@
(
:nicknames
#:clpm
)
(
:use
#:cl
#:clpm/bundle
#:clpm/config
#:clpm/context
#:clpm/context-diff
#:clpm/install
#:clpm/source
#:clpm/update
#:clpm/version
)
(
:export
#:install
)
;; From config
(
:export
#:config-value
)
;; From update
(
:export
#:update
)
;; From version
(
:export
#:clpm-version
))
...
...
clpm/update.lisp
View file @
71972b91
...
...
@@ -11,6 +11,7 @@
#:clpm/install/defs
#:clpm/log
#:clpm/resolve
#:clpm/session
#:clpm/source
)
(
:export
#:update
))
...
...
@@ -21,21 +22,22 @@
(
defun
update
(
&key
update-projects
update-systems
(
validate
(
constantly
t
))
context
)
(
let*
((
orig-context
(
get-context
context
))
(
context
(
copy-context
orig-context
)))
;; Map all systems to their corresponding projects.
(
dolist
(
system
update-systems
)
(
when-let*
((
system-release
(
find
system
(
context-system-releases
orig-context
)
: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
)))
(
with-clpm-session
()
(
let*
((
orig-context
(
get-context
context
))
(
context
(
copy-context
orig-context
)))
;; Map all systems to their corresponding projects.
(
dolist
(
system
update-systems
)
(
when-let*
((
system-release
(
find
system
(
context-system-releases
orig-context
)
: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
)))
(
log:info
"Updating ~:[all~;~:*~{~A~^, ~}~] projects."
update-projects
)
(
let*
((
new-context
(
resolve-requirements
context
:update-projects
(
or
update-projects
t
)))
(
diff
(
make-context-diff
orig-context
new-context
)))
(
when
(
funcall
validate
diff
)
(
mapc
#'
install-release
(
context-releases
new-context
))
(
context-write-asdf-files
new-context
)
(
save-context
new-context
)))))
(
log:info
"Updating ~:[all~;~:*~{~A~^, ~}~] projects."
update-projects
)
(
let*
((
new-context
(
resolve-requirements
context
:update-projects
(
or
update-projects
t
)))
(
diff
(
make-context-diff
orig-context
new-context
)))
(
when
(
funcall
validate
diff
)
(
mapc
#'
install-release
(
context-releases
new-context
))
(
context-write-asdf-files
new-context
)
(
save-context
new-context
)))))
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment