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
21512229
Commit
21512229
authored
May 15, 2020
by
Eric Timmons
Browse files
Simplify context printing based on client code
parent
eab58c5a
Changes
6
Hide whitespace changes
Inline
Side-by-side
cli/interface-defs.lisp
View file @
21512229
...
...
@@ -9,6 +9,7 @@
#:clpm-cli/common-args
#:clpm/config
#:clpm/context
#:clpm/context-diff
#:clpm/log
#:clpm/version
)
(
:import-from
#:adopt
)
...
...
@@ -135,9 +136,9 @@ command line, and a hash table created by Adopt when parsing the options.")
(
defun
make-diff-validate-fun
(
&key
yesp
(
stream
*standard-output*
))
(
lambda
(
diff
)
(
block
nil
(
unless
(
context-diff-
has-diff
-p
diff
)
(
when
(
context-diff-
empty
-p
diff
)
(
return
t
))
(
print-context-diff
diff
stream
)
(
print-context-diff
-to-stream
diff
stream
:use-color-p
(
interactive-stream-p
stream
)
)
(
or
yesp
(
y-or-n-p
"Proceed?"
)))))
(
defmacro
define-string
(
name
string
)
...
...
clpm/clpm.lisp
View file @
21512229
...
...
@@ -8,6 +8,7 @@
(
:use
#:cl
#:clpm/bundle
#:clpm/context
#:clpm/context-diff
#:clpm/install
#:clpm/source
#:clpm/version
)
...
...
clpm/context-diff.lisp
0 → 100644
View file @
21512229
;;;; Context Diffs
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(
uiop:define-package
#:clpm/context-diff
(
:use
#:cl
#:alexandria
#:anaphora
#:cl-ansi-text
#:clpm/context
#:clpm/source
)
(
:export
#:context-diff-empty-p
#:context-diff-to-plist
#:make-context-diff
#:print-context-diff-to-stream
))
(
in-package
#:clpm/context-diff
)
(
defclass
context-diff
()
((
release-diffs
:initarg
:release-diffs
:initform
nil
:reader
context-diff-release-diffs
))
(
:documentation
"A representation of changes that will be made to a context."
))
(
defclass
release-diff
()
((
project-name
:initarg
:project-name
:reader
release-diff-project-name
)
(
old-version
:initform
nil
:initarg
:old-version
:reader
release-diff-old-version
)
(
new-version
:initform
nil
:initarg
:new-version
:reader
release-diff-new-version
)
(
old-source
:initform
nil
:initarg
:old-source
:reader
release-diff-old-source
)
(
new-source
:initform
nil
:initarg
:new-source
:reader
release-diff-new-source
))
(
:documentation
"A representation of a change to a single project."
))
(
defun
make-context-diff
(
old-context
new-context
)
(
let*
((
old-releases
(
context-releases
old-context
))
(
new-releases
(
context-releases
new-context
))
(
all-projects
(
union
(
mapcar
(
compose
#'
project-name
#'
release-project
)
old-releases
)
(
mapcar
(
compose
#'
project-name
#'
release-project
)
new-releases
)
:test
'equal
)))
(
make-instance
'context-diff
:release-diffs
(
loop
:for
project-name
:in
all-projects
:for
old-release
:=
(
find
project-name
old-releases
:key
(
compose
#'
project-name
#'
release-project
)
:test
'equal
)
:for
new-release
:=
(
find
project-name
new-releases
:key
(
compose
#'
project-name
#'
release-project
)
:test
'equal
)
:if
(
not
(
eql
old-release
new-release
))
:collect
(
apply
#'
make-instance
'release-diff
:project-name
project-name
(
append
(
when
old-release
(
list
:old-source
(
source-name
(
release-source
old-release
))
:old-version
(
release-version
old-release
)))
(
when
new-release
(
list
:new-source
(
source-name
(
release-source
new-release
))
:new-version
(
release-version
new-release
)))))))))
;; Serializing
(
defun
context-diff-to-plist
(
diff
)
(
list
:releases
(
mapcar
#'
release-diff-to-plist
(
context-diff-release-diffs
diff
))))
(
defun
release-diff-to-plist
(
diff
)
`
(
:project-name
,
(
release-diff-project-name
diff
)
,@
(
awhen
(
release-diff-old-version
diff
)
(
list
:old-version
it
))
,@
(
awhen
(
release-diff-new-version
diff
)
(
list
:new-version
it
))
,@
(
awhen
(
release-diff-old-source
diff
)
(
list
:old-source
it
))
,@
(
awhen
(
release-diff-new-source
diff
)
(
list
:new-source
it
))))
(
defun
context-diff-empty-p
(
diff
)
"Returns non-NIL if DIFF contains no changes."
(
null
(
context-diff-release-diffs
diff
)))
(
defun
context-diff-column-widths
(
diff
)
"Returns a list of 5 integers detailing the column widths needed to print a
diff. The first column is the project name, then old version, new version, old
source, and finally new source."
(
flet
((
printed-length
(
x
)
(
if
(
stringp
x
)
(
length
x
)
(
length
(
format
nil
"~A"
x
)))))
(
list
(
max
(
length
"Project"
)
(
reduce
#'
max
(
context-diff-release-diffs
diff
)
:key
(
lambda
(
release-diff
)
(
printed-length
(
release-diff-project-name
release-diff
)))
:initial-value
0
))
(
max
(
length
"Old Version"
)
(
reduce
#'
max
(
context-diff-release-diffs
diff
)
:key
(
lambda
(
release-diff
)
(
printed-length
(
release-diff-old-version
release-diff
)))
:initial-value
0
))
(
max
(
length
"New Version"
)
(
reduce
#'
max
(
context-diff-release-diffs
diff
)
:key
(
lambda
(
release-diff
)
(
printed-length
(
release-diff-new-version
release-diff
)))
:initial-value
0
))
(
max
(
length
"Old Source"
)
(
reduce
#'
max
(
context-diff-release-diffs
diff
)
:key
(
lambda
(
release-diff
)
(
printed-length
(
release-diff-old-source
release-diff
)))
:initial-value
0
))
(
max
(
length
"New Source"
)
(
reduce
#'
max
(
context-diff-release-diffs
diff
)
:key
(
lambda
(
release-diff
)
(
printed-length
(
release-diff-new-source
release-diff
)))
:initial-value
0
)))))
(
defun
print-context-diff-to-stream
(
diff
stream
&key
use-color-p
)
"Print a human readable description of DIFF to STREAM."
(
flet
((
num
(
x
)
(
format
nil
"~D"
x
))
(
color
(
x
)
(
when
use-color-p
(
if
(
eql
x
:reset
)
+reset-color-string+
(
make-color-string
x
)))))
(
let*
((
column-lengths
(
context-diff-column-widths
diff
))
(
header-format-string
(
uiop:strcat
;; Project name
"~"
(
num
(
first
column-lengths
))
"<~A~> "
;; Old Version
"~"
(
num
(
second
column-lengths
))
"<~@[~A~]~>"
;; Arrow
" ~:*~:[ ~;~:[ ~;->~]~:*~] "
;; New Version
"~"
(
num
(
third
column-lengths
))
"<~@[~A~]~> "
;; Old Source
"~"
(
num
(
fourth
column-lengths
))
"<~@[~A~]~>"
;; Arrow
" ~:*~:[ ~;~:[ ~;->~]~:*~] "
;; New Version
"~"
(
num
(
fifth
column-lengths
))
"<~@[~A~]~>~%"
))
(
row-format-string
(
uiop:strcat
;; Project name
(
color
:green
)
"~"
(
num
(
first
column-lengths
))
"<~A~> "
;; Old Version
(
color
:red
)
"~"
(
num
(
second
column-lengths
))
"<~@[~A~]~>"
;; Arrow
(
color
:reset
)
" ~:*~:[ ~;~:[ ~;->~]~:*~] "
;; New Version
(
color
:blue
)
"~"
(
num
(
third
column-lengths
))
"<~@[~A~]~> "
;; Old Source
(
color
:red
)
"~"
(
num
(
fourth
column-lengths
))
"<~@[~A~]~>"
;; Arrow
(
color
:reset
)
" ~:*~:[ ~;~:[ ~;->~]~:*~] "
;; New Version
(
color
:blue
)
"~"
(
num
(
fifth
column-lengths
))
"<~@[~A~]~>~%"
;; Reset color
(
color
:reset
))))
(
format
stream
header-format-string
"Project"
"Old Version"
"New Version"
"Old Source"
"New Source"
)
(
dolist
(
release-diff
(
sort
(
copy-list
(
context-diff-release-diffs
diff
))
#'
string<
:key
#'
release-diff-project-name
))
(
format
stream
row-format-string
(
release-diff-project-name
release-diff
)
(
release-diff-old-version
release-diff
)
(
release-diff-new-version
release-diff
)
(
release-diff-old-source
release-diff
)
(
release-diff-new-source
release-diff
))))))
clpm/context.lisp
View file @
21512229
...
...
@@ -17,9 +17,6 @@
(
:export
#:context
#:context-add-requirement!
#:context-asd-pathnames
#:context-diff
#:context-diff-has-diff-p
#:context-diff-to-plist
#:context-find-system-asd-pathname
#:context-installed-systems
#:context-installed-only-p
...
...
@@ -38,7 +35,6 @@
#:get-context
#:load-anonymous-context-from-pathname
#:load-global-context
#:print-context-diff
#:save-global-context
#:serialize-context-to-stream
))
...
...
@@ -254,168 +250,6 @@ in place with the same name. Return the new requirement if it was modified."
:ensure-directory
t
)))
:implementation
:**/
:*.*.*
))))))
;; * Diffing
(
defclass
context-diff
()
((
added-releases
:initarg
:added-releases
:initform
nil
:accessor
context-diff-added-releases
)
(
removed-releases
:initarg
:removed-releases
:initform
nil
:accessor
context-diff-removed-releases
)))
(
defun
context-diff
(
old-context
new-context
)
(
let*
((
old-releases
(
context-releases
old-context
))
(
new-releases
(
context-releases
new-context
))
(
added-releases
(
set-difference
new-releases
old-releases
))
(
removed-releases
(
set-difference
old-releases
new-releases
)))
(
make-instance
'context-diff
:added-releases
(
remove
'fs-release
added-releases
:key
#'
type-of
)
:removed-releases
(
remove
'fs-release
removed-releases
:key
#'
type-of
))))
(
defun
context-diff-has-diff-p
(
diff
)
(
or
(
context-diff-added-releases
diff
)
(
context-diff-removed-releases
diff
)))
(
defun
context-diff-to-plist
(
diff
&key
stringify-commits-p
)
(
let
((
removed-releases
(
context-diff-removed-releases
diff
))
(
added-releases
(
context-diff-added-releases
diff
))
(
changed-releases
nil
))
(
dolist
(
r
added-releases
)
(
when-let
((
matching-release
(
find
(
release-project
r
)
removed-releases
:key
#'
release-project
)))
(
removef
removed-releases
matching-release
)
(
removef
added-releases
r
)
(
push
(
cons
matching-release
r
)
changed-releases
)))
(
labels
((
release-to-plist
(
r
)
(
let
((
version
(
release-version
r
)))
(
list
:version
(
if
(
and
(
listp
version
)
stringify-commits-p
)
(
format
nil
"commit ~A"
(
second
version
))
version
)
:source
(
source-name
(
release-source
r
)))))
(
release-to-form
(
r
)
(
list*
(
project-name
(
release-project
r
))
(
release-to-plist
r
)))
(
changed-release-to-form
(
cell
)
(
destructuring-bind
(
old
.
new
)
cell
(
list
(
project-name
(
release-project
old
))
:old
(
release-to-plist
old
)
:new
(
release-to-plist
new
)))))
(
list
:added-releases
(
sort
(
mapcar
#'
release-to-form
added-releases
)
'string<
:key
#'
car
)
:removed-releases
(
sort
(
mapcar
#'
release-to-form
removed-releases
)
'string<
:key
#'
car
)
:changed-releases
(
sort
(
mapcar
#'
changed-release-to-form
changed-releases
)
'string<
:key
#'
car
)))))
(
defun
print-diff-release
(
r
stream
)
(
format
stream
"~A~50,1,4<~A~;~A~^~;~A~;~A~^~>"
(
make-color-string
:green
)
(
project-name
(
release-project
r
))
(
make-color-string
:blue
)
(
release-version
r
)
+reset-color-string+
))
(
defun
print-diff-release-change
(
pair
stream
)
(
destructuring-bind
(
to
.
from
)
pair
(
format
stream
"~A~65,1,4<~A~;~A~^~;~A -> ~A~;~A~^~>"
(
make-color-string
:green
)
(
project-name
(
release-project
from
))
(
make-color-string
:blue
)
(
release-version
from
)
(
release-version
to
)
+reset-color-string+
)))
(
defun
make-diff-format-string
(
spacing
name-length
old-version-length
new-version-length
old-source-length
new-source-length
&key
use-color-p
)
(
let
((
counter
0
)
(
spacing
(
+
spacing
(
if
use-color-p
(
length
(
make-color-string
:green
))
0
))))
(
flet
((
num
(
x
)
(
format
nil
"~D"
x
))
(
color
(
x
)
(
when
use-color-p
(
make-color-string
x
))))
(
uiop:strcat
;; Project name column
(
color
:green
)
"~@[~A~]~"
(
num
(
incf
counter
(
+
name-length
spacing
)))
"T"
;; Old version column
(
color
:red
)
"~@[~A~]~"
(
num
(
incf
counter
(
+
old-version-length
spacing
)))
"T"
;; New version column
(
color
:blue
)
"~@[~A~]~"
(
num
(
incf
counter
(
+
new-version-length
spacing
)))
"T"
;; Old source column
(
color
:red
)
"~@[~A~]~"
(
num
(
incf
counter
(
+
old-source-length
spacing
)))
"T"
;; New source column
(
color
:blue
)
"~@[~A~]~"
(
num
(
incf
counter
(
+
new-source-length
spacing
)))
"T"
;; Reset color
(
when
use-color-p
+reset-color-string+
)))))
(
defun
print-context-diff
(
diff
stream
)
;; Compute the maximum project length.
(
flet
((
max-length
(
list
&key
(
key
'identity
))
(
reduce
#'
max
list
:key
(
compose
(
lambda
(
x
)
(
if
(
stringp
x
)
(
length
x
)
(
length
(
format
nil
"~A"
x
))))
key
)
:initial-value
0
)))
(
let*
((
plist
(
context-diff-to-plist
diff
:stringify-commits-p
t
))
(
max-name-length
(
max
(
length
"Project"
)
(
max-length
(
getf
plist
:added-releases
)
:key
#'
car
)
(
max-length
(
getf
plist
:removed-releases
)
:key
#'
car
)
(
max-length
(
getf
plist
:changed-releases
)
:key
#'
car
)))
(
max-old-version-length
(
max
(
length
"Old Version"
)
(
max-length
(
getf
plist
:removed-releases
)
:key
(
lambda
(
x
)
(
getf
(
rest
x
)
:version
)))
(
max-length
(
getf
plist
:changed-releases
)
:key
(
lambda
(
x
)
(
getf
(
getf
(
rest
x
)
:old
)
:version
)))))
(
max-new-version-length
(
max
(
length
"New Version"
)
(
max-length
(
getf
plist
:added-releases
)
:key
(
lambda
(
x
)
(
getf
(
rest
x
)
:version
)))
(
max-length
(
getf
plist
:changed-releases
)
:key
(
lambda
(
x
)
(
getf
(
getf
(
rest
x
)
:new
)
:version
)))))
(
max-old-source-length
(
max
(
length
"Old Source"
)
(
max-length
(
getf
plist
:removed-releases
)
:key
(
lambda
(
x
)
(
getf
(
rest
x
)
:source
)))
(
max-length
(
getf
plist
:changed-releases
)
:key
(
lambda
(
x
)
(
getf
(
getf
(
rest
x
)
:old
)
:source
)))))
(
max-new-source-length
(
max
(
length
"New Source"
)
(
max-length
(
getf
plist
:added-releases
)
:key
(
lambda
(
x
)
(
getf
(
rest
x
)
:source
)))
(
max-length
(
getf
plist
:changed-releases
)
:key
(
lambda
(
x
)
(
getf
(
getf
(
rest
x
)
:new
)
:source
)))))
(
format-string
(
make-diff-format-string
4
max-name-length
max-old-version-length
max-new-version-length
max-old-source-length
max-new-source-length
:use-color-p
(
and
(
not
(
featurep
:windows
))
(
interactive-stream-p
stream
))))
(
no-color-format-string
(
make-diff-format-string
4
max-name-length
max-old-version-length
max-new-version-length
max-old-source-length
max-new-source-length
)))
;; Print all the added releases:
(
format
stream
no-color-format-string
"Project"
"Old Version"
"New Version"
"Old Source"
"New Source"
)
(
terpri
stream
)
(
dolist
(
diff
(
getf
plist
:added-releases
))
(
format
stream
format-string
(
car
diff
)
nil
(
getf
(
cdr
diff
)
:version
)
nil
(
getf
(
cdr
diff
)
:source
))
(
terpri
stream
))
(
dolist
(
diff
(
getf
plist
:changed-releases
))
(
let
((
old
(
getf
(
cdr
diff
)
:old
))
(
new
(
getf
(
cdr
diff
)
:new
)))
(
format
stream
format-string
(
car
diff
)
(
getf
old
:version
)
(
getf
new
:version
)
(
getf
old
:source
)
(
getf
new
:source
)))
(
terpri
stream
))
(
dolist
(
diff
(
getf
plist
:removed-releases
))
(
format
stream
format-string
(
car
diff
)
(
getf
(
cdr
diff
)
:version
)
nil
(
getf
(
cdr
diff
)
:source
)
nil
)
(
terpri
stream
)))))
;; * Deserializing
...
...
clpm/install.lisp
View file @
21512229
...
...
@@ -8,6 +8,7 @@
#:alexandria
#:anaphora
#:clpm/context
#:clpm/context-diff
#:clpm/install/defs
#:clpm/log
#:clpm/resolve
...
...
@@ -115,7 +116,7 @@ install should proceed."
(
dolist
(
r
reqs
)
(
context-add-requirement!
new-context
r
))
(
setf
new-context
(
resolve-requirements
new-context
:update-projects
update-projects
))
(
let
((
result
(
funcall
validate
(
context-diff
orig-context
new-context
))))
(
let
((
result
(
funcall
validate
(
make-
context-diff
orig-context
new-context
))))
(
if
result
(
progn
(
mapc
#'
install-release
(
context-releases
new-context
))
...
...
clpm/update.lisp
View file @
21512229
...
...
@@ -7,6 +7,7 @@
(
:use
#:cl
#:alexandria
#:clpm/context
#:clpm/context-diff
#:clpm/install/defs
#:clpm/log
#:clpm/resolve
...
...
@@ -33,7 +34,7 @@
(
log:info
"Updating ~:[all~;~:*~{~A~^, ~}~] projects."
update-projects
)
(
let*
((
new-context
(
resolve-requirements
context
:update-projects
(
or
update-projects
t
)))
(
diff
(
context-diff
orig-context
new-context
)))
(
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
)
...
...
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