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
3537989e
Commit
3537989e
authored
Feb 18, 2020
by
Eric Timmons
Browse files
Fixup bundle update command
parent
380d677a
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/clpm/bundle.lisp
View file @
3537989e
...
...
@@ -24,11 +24,11 @@
:sources
(
clpmfile-sources
clpmfile
)
:requirements
(
clpmfile-all-requirements
clpmfile
)))
(
defun
build-lockfile
(
clpmfile
&key
local
)
(
defun
build-lockfile
(
clpmfile
&key
local
p
)
"Given a clpmfile instance, make a lockfile context for it."
(
let*
((
lockfile
(
create-empty-lockfile
clpmfile
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
)))
(
unless
local
(
unless
local
p
(
log:info
"syncing sources"
)
(
mapc
#'
sync-source
(
clpmfile-sources
clpmfile
)))
(
log:info
"Resolving requirements"
)
...
...
@@ -38,25 +38,25 @@
(
serialize-context-to-stream
lockfile
stream
))
lockfile
))
(
defun
load-lockfile
(
pathname
&key
local
)
(
defun
load-lockfile
(
pathname
&key
local
p
)
(
handler-bind
((
source-no-such-object
(
lambda
(
c
)
(
when
(
and
(
find-restart
'sync-and-retry
)
(
not
local
))
(
when
(
and
(
find-restart
'sync-and-retry
)
(
not
local
p
))
(
log:info
"Syncing source and retrying"
)
(
invoke-restart
'sync-and-retry
c
)))))
(
load-anonymous-context-from-pathname
pathname
)))
(
defun
bundle-install
(
clpmfile-designator
&key
local
(
validate
(
constantly
t
)))
(
defun
bundle-install
(
clpmfile-designator
&key
local
p
(
validate
(
constantly
t
)))
"Given a clpmfile instance, install all releases from its lock file, creating
the lock file if necessary."
(
let*
((
clpmfile
(
get-clpmfile
clpmfile-designator
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
))
(
lockfile
nil
))
(
if
(
probe-file
lockfile-pathname
)
(
setf
lockfile
(
load-lockfile
lockfile-pathname
:local
local
))
(
setf
lockfile
(
load-lockfile
lockfile-pathname
:local
p
local
p
))
(
setf
lockfile
(
create-empty-lockfile
clpmfile
)))
(
unless
local
(
unless
local
p
(
mapc
#'
sync-source
(
clpmfile-sources
clpmfile
)))
(
setf
lockfile
(
install-requirements
(
clpmfile-all-requirements
clpmfile
)
:context
lockfile
:validate
validate
))
...
...
@@ -66,22 +66,32 @@ the lock file if necessary."
(
serialize-context-to-stream
lockfile
stream
))))
(
defun
bundle-update
(
clpmfile-designator
&key
update-projects
(
validate
(
constantly
t
)))
update-projects
(
validate
(
constantly
t
))
update-systems
localp
)
(
let*
((
clpmfile
(
get-clpmfile
clpmfile-designator
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
))
(
lockfile
nil
))
(
log:info
"syncing sources"
)
(
mapc
#'
sync-source
(
clpmfile-sources
clpmfile
))
(
if
(
probe-file
lockfile-pathname
)
;; Load the existing lockfile
(
setf
lockfile
(
load-lockfile
lockfile-pathname
))
;; No lock file is present. Create an empty context.
(
setf
lockfile
(
create-empty-lockfile
clpmfile
)))
;; Resolve the requirements, allowing for updates.
(
let*
((
new-lockfile
(
resolve-requirements
lockfile
:update-projects
(
or
update-projects
t
)))
(
diff
(
context-diff
lockfile
new-lockfile
)))
(
when
(
funcall
validate
diff
)
(
mapc
#'
install-release
(
context-releases
new-lockfile
))
(
with-open-file
(
stream
lockfile-pathname
:direction
:output
:if-exists
:supersede
)
(
serialize-context-to-stream
new-lockfile
stream
))))))
(
unless
(
probe-file
lockfile-pathname
)
;; There is no lock file currently. Just fall back to BUNDLE-INSTALL.
(
return-from
bundle-update
(
bundle-install
clpmfile
:localp
localp
:validate
validate
)))
;; Load the existing lockfile
(
setf
lockfile
(
load-lockfile
lockfile-pathname
:localp
localp
))
(
unless
localp
(
mapc
#'
sync-source
(
clpmfile-sources
clpmfile
)))
;; Map all update systems to their projects.
(
dolist
(
system
update-systems
)
(
when-let*
((
system-release
(
find
system
(
context-system-releases
lockfile
)
: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
)))
(
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
))))
src/clpm/cli/bundle/install.lisp
View file @
3537989e
...
...
@@ -50,7 +50,7 @@ exist in the lock file.")
(
define-cli-command
((
"bundle"
"install"
)
*bundle-install-ui*
)
(
args
options
)
(
let
((
clpmfile-pathname
(
merge-pathnames
(
gethash
:bundle-file
options
)
(
uiop:getcwd
))))
(
bundle-install
clpmfile-pathname
:local
(
gethash
:bundle-local
options
)
(
bundle-install
clpmfile-pathname
:local
p
(
gethash
:bundle-local
options
)
:validate
(
make-validate-fun
(
gethash
:yes
options
)
(
gethash
:output
options
)))
t
))
src/clpm/cli/bundle/update.lisp
View file @
3537989e
...
...
@@ -8,7 +8,9 @@
#:clpm/bundle
#:clpm/cli/bundle/common
#:clpm/cli/common-args
#:clpm/cli/defs
#:clpm/cli/subcommands
#:clpm/context
#:clpm/log
)
(
:import-from
#:adopt
))
...
...
@@ -16,17 +18,48 @@
(
setup-logger
)
(
define-string
*help-string*
"Update a bundle described in a clpmfile. Can either update the whole bundle
or a subset.
If no clpmfile.lock file exists, one is created by first syncing all sources in
the clpmfile and using the requirements to resolve a set of project releases
that satisfy them all. All of the releases are then installed locally and the
lock file is written.
If a lock file does exist, all sources are synced and the requirements
re-resolved from scratch. If a list of systems to update is provided, then the
preference for unrelated projects is to keep them at the same version as
currently in the lock file. If no systems to update are provided then the
preference is to update everything to the latest version possible."
)
(
defparameter
*bundle-update-ui*
(
adopt:make-interface
:name
"clpm bundle update"
:summary
"Common Lisp Package Manager Bundle Update"
:usage
"bundle update [options] <
PROJECTS*>
"
:help
"Update a bundle"
:usage
"bundle update [options] <
SYSTEM>*
"
:help
*help-string*
:contents
(
list
*group-common*
*group-bundle*
)))
*group-bundle*
*option-bundle-local*
*option-yes*
*option-output*
)))
(
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*
))
(
or
yesp
(
y-or-n-p
"Proceed?"
))))
(
define-cli-command
((
"bundle"
"update"
)
*bundle-update-ui*
)
(
args
options
)
(
let
((
clpmfile-pathname
(
merge-pathnames
(
gethash
:bundle-file
options
)
(
uiop:getcwd
))))
(
bundle-update
clpmfile-pathname
)
(
uiop:getcwd
)))
(
localp
(
gethash
:bundle-local
options
))
(
yesp
(
gethash
:yes
options
))
(
output
(
gethash
:output
options
)))
(
bundle-update
clpmfile-pathname
:update-systems
args
:localp
localp
:validate
(
make-validate-fun
yesp
output
))
t
))
src/clpm/install.lisp
View file @
3537989e
...
...
@@ -65,10 +65,10 @@
(
defun
install-requirements
(
reqs
&key
context
(
validate
(
constantly
t
))
save-context-p
)
save-context-p
update-projects
)
(
let*
((
orig-context
(
get-context
context
))
(
new-context
(
copy-context
orig-context
))
(
update-projects
nil
))
(
new-context
(
copy-context
orig-context
)))
(
dolist
(
r
reqs
)
(
context-add-requirement!
new-context
r
))
(
setf
new-context
(
resolve-requirements
new-context
:update-projects
update-projects
))
...
...
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