Commit 21512229 authored by Eric Timmons's avatar Eric Timmons
Browse files

Simplify context printing based on client code

parent eab58c5a
......@@ -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)
......
......@@ -8,6 +8,7 @@
(:use #:cl
#:clpm/bundle
#:clpm/context
#:clpm/context-diff
#:clpm/install
#:clpm/source
#:clpm/version)
......
;;;; 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))))))
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
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