guix package: Add '--list-generations'.
* guix/scripts/package.scm: Import (srfi srfi-19). (generation-time, matching-generations): New functions. (show-help): Add '--list-generations'. (%options): Likewise. (guix-package)[process-query]: Add support for '--list-generations'. * guix/ui.scm: Import (srfi srfi-19) and (ice-9 regex). (string->generations, string->duration): New functions. * tests/guix-package.sh: Test '--list-generations'. * tests/ui.scm: Import (srfi srfi-19). Test 'string->generations' and 'string->duration'. * doc/guix.texi (Invoking guix-package): Document '--list-generations'.
This commit is contained in:
parent
72d9148fbf
commit
2cd09108c9
|
@ -606,6 +606,39 @@ library are installed in the profile, then @code{--search-paths} will
|
||||||
suggest setting these variables to @code{@var{profile}/include} and
|
suggest setting these variables to @code{@var{profile}/include} and
|
||||||
@code{@var{profile}/lib}, respectively.
|
@code{@var{profile}/lib}, respectively.
|
||||||
|
|
||||||
|
@item --list-generations[=@var{pattern}]
|
||||||
|
@itemx -l [@var{pattern}]
|
||||||
|
Return a list of generations along with their creation dates.
|
||||||
|
|
||||||
|
For each installed package, print the following items, separated by
|
||||||
|
tabs: the name of a package, its version string, the part of the package
|
||||||
|
that is installed (@pxref{Packages with Multiple Outputs}), and the
|
||||||
|
location of this package in the store.
|
||||||
|
|
||||||
|
When @var{pattern} is used, the command returns only matching
|
||||||
|
generations. Valid patterns include:
|
||||||
|
|
||||||
|
@itemize
|
||||||
|
@item @emph{Integers and comma-separated integers}. Both patterns denote
|
||||||
|
generation numbers. For instance, @code{--list-generations=1} returns
|
||||||
|
the first one.
|
||||||
|
|
||||||
|
And @code{--list-generations=1,8,2} outputs three generations in the
|
||||||
|
specified order. Neither spaces nor trailing commas are allowed.
|
||||||
|
|
||||||
|
@item @emph{Ranges}. @code{--list-generations=2..9} prints the
|
||||||
|
specified generations and everything in between. Note that the start of
|
||||||
|
a range must be lesser than its end.
|
||||||
|
|
||||||
|
It is also possible to omit the endpoint. For example,
|
||||||
|
@code{--list-generations=2..}, returns all generations starting from the
|
||||||
|
second one.
|
||||||
|
|
||||||
|
@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks,
|
||||||
|
or months by passing an integer along with the first letter of the
|
||||||
|
duration, e.g., @code{--list-generations=20d}.
|
||||||
|
@end itemize
|
||||||
|
|
||||||
@item --profile=@var{profile}
|
@item --profile=@var{profile}
|
||||||
@itemx -p @var{profile}
|
@itemx -p @var{profile}
|
||||||
Use @var{profile} instead of the user's default profile.
|
Use @var{profile} instead of the user's default profile.
|
||||||
|
|
|
@ -34,6 +34,7 @@
|
||||||
#:use-module (ice-9 vlist)
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
@ -243,6 +244,74 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
|
||||||
(switch-link)))
|
(switch-link)))
|
||||||
(else (switch-link))))) ; anything else
|
(else (switch-link))))) ; anything else
|
||||||
|
|
||||||
|
(define (generation-time profile number)
|
||||||
|
"Return the creation time of a generation in the UTC format."
|
||||||
|
(make-time time-utc 0
|
||||||
|
(stat:ctime (stat (format #f "~a-~a-link" profile number)))))
|
||||||
|
|
||||||
|
(define* (matching-generations str #:optional (profile %current-profile))
|
||||||
|
"Return the list of available generations matching a pattern in STR. See
|
||||||
|
'string->generations' and 'string->duration' for the list of valid patterns."
|
||||||
|
(define (valid-generations lst)
|
||||||
|
(define (valid-generation? n)
|
||||||
|
(any (cut = n <>) (generation-numbers profile)))
|
||||||
|
|
||||||
|
(fold-right (lambda (x acc)
|
||||||
|
(if (valid-generation? x)
|
||||||
|
(cons x acc)
|
||||||
|
acc))
|
||||||
|
'()
|
||||||
|
lst))
|
||||||
|
|
||||||
|
(define (filter-generations generations)
|
||||||
|
(match generations
|
||||||
|
(() '())
|
||||||
|
(('>= n)
|
||||||
|
(drop-while (cut > n <>)
|
||||||
|
(generation-numbers profile)))
|
||||||
|
(('<= n)
|
||||||
|
(valid-generations (iota n 1)))
|
||||||
|
((lst ..1)
|
||||||
|
(valid-generations lst))
|
||||||
|
(_ #f)))
|
||||||
|
|
||||||
|
(define (filter-by-duration duration)
|
||||||
|
(define (time-at-midnight time)
|
||||||
|
;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and
|
||||||
|
;; hours to zeros.
|
||||||
|
(let ((d (time-utc->date time)))
|
||||||
|
(date->time-utc
|
||||||
|
(make-date 0 0 0 0
|
||||||
|
(date-day d) (date-month d)
|
||||||
|
(date-year d) (date-zone-offset d)))))
|
||||||
|
|
||||||
|
(define generation-ctime-alist
|
||||||
|
(map (lambda (number)
|
||||||
|
(cons number
|
||||||
|
(time-second
|
||||||
|
(time-at-midnight
|
||||||
|
(generation-time profile number)))))
|
||||||
|
(generation-numbers profile)))
|
||||||
|
|
||||||
|
(match duration
|
||||||
|
(#f #f)
|
||||||
|
(res
|
||||||
|
(let ((s (time-second
|
||||||
|
(subtract-duration (time-at-midnight (current-time))
|
||||||
|
duration))))
|
||||||
|
(delete #f (map (lambda (x)
|
||||||
|
(and (<= s (cdr x))
|
||||||
|
(first x)))
|
||||||
|
generation-ctime-alist))))))
|
||||||
|
|
||||||
|
(cond ((string->generations str)
|
||||||
|
=>
|
||||||
|
filter-generations)
|
||||||
|
((string->duration str)
|
||||||
|
=>
|
||||||
|
filter-by-duration)
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
(define (find-packages-by-description rx)
|
(define (find-packages-by-description rx)
|
||||||
"Search in SYNOPSIS and DESCRIPTION using RX. Return a list of
|
"Search in SYNOPSIS and DESCRIPTION using RX. Return a list of
|
||||||
matching packages."
|
matching packages."
|
||||||
|
@ -438,6 +507,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
--roll-back roll back to the previous generation"))
|
--roll-back roll back to the previous generation"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--search-paths display needed environment variable definitions"))
|
--search-paths display needed environment variable definitions"))
|
||||||
|
(display (_ "
|
||||||
|
-l, --list-generations[=PATTERN]
|
||||||
|
list generations matching PATTERN"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
|
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
|
||||||
|
@ -497,6 +569,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(option '("roll-back") #f #f
|
(option '("roll-back") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'roll-back? #t result)))
|
(alist-cons 'roll-back? #t result)))
|
||||||
|
(option '(#\l "list-generations") #f #t
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(cons `(query list-generations ,(or arg ""))
|
||||||
|
result)))
|
||||||
(option '("search-paths") #f #f
|
(option '("search-paths") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(cons `(query search-paths) result)))
|
(cons `(query search-paths) result)))
|
||||||
|
@ -876,6 +952,37 @@ more information.~%"))
|
||||||
;; actually processed, #f otherwise.
|
;; actually processed, #f otherwise.
|
||||||
(let ((profile (assoc-ref opts 'profile)))
|
(let ((profile (assoc-ref opts 'profile)))
|
||||||
(match (assoc-ref opts 'query)
|
(match (assoc-ref opts 'query)
|
||||||
|
(('list-generations pattern)
|
||||||
|
(define (list-generation number)
|
||||||
|
(begin
|
||||||
|
(format #t "Generation ~a\t~a~%" number
|
||||||
|
(date->string
|
||||||
|
(time-utc->date
|
||||||
|
(generation-time profile number))
|
||||||
|
"~b ~d ~Y ~T"))
|
||||||
|
(for-each (match-lambda
|
||||||
|
((name version output location _)
|
||||||
|
(format #t " ~a\t~a\t~a\t~a~%"
|
||||||
|
name version output location)))
|
||||||
|
(manifest-packages
|
||||||
|
(profile-manifest
|
||||||
|
(format #f "~a-~a-link" profile number))))
|
||||||
|
(newline)))
|
||||||
|
|
||||||
|
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||||
|
(leave (_ "profile '~a' does not exist~%")
|
||||||
|
profile))
|
||||||
|
((string-null? pattern)
|
||||||
|
(for-each list-generation
|
||||||
|
(generation-numbers profile)))
|
||||||
|
((matching-generations pattern profile)
|
||||||
|
=>
|
||||||
|
(cut for-each list-generation <>))
|
||||||
|
(else
|
||||||
|
(leave (_ "invalid syntax: ~a~%")
|
||||||
|
pattern)))
|
||||||
|
#t)
|
||||||
|
|
||||||
(('list-installed regexp)
|
(('list-installed regexp)
|
||||||
(let* ((regexp (and regexp (make-regexp regexp)))
|
(let* ((regexp (and regexp (make-regexp regexp)))
|
||||||
(manifest (profile-manifest profile))
|
(manifest (profile-manifest profile))
|
||||||
|
|
68
guix/ui.scm
68
guix/ui.scm
|
@ -28,12 +28,14 @@
|
||||||
#:use-module ((guix licenses) #:select (license? license-name))
|
#:use-module ((guix licenses) #:select (license? license-name))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:autoload (ice-9 ftw) (scandir)
|
#:autoload (ice-9 ftw) (scandir)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:export (_
|
#:export (_
|
||||||
N_
|
N_
|
||||||
leave
|
leave
|
||||||
|
@ -50,6 +52,8 @@
|
||||||
fill-paragraph
|
fill-paragraph
|
||||||
string->recutils
|
string->recutils
|
||||||
package->recutils
|
package->recutils
|
||||||
|
string->generations
|
||||||
|
string->duration
|
||||||
args-fold*
|
args-fold*
|
||||||
run-guix-command
|
run-guix-command
|
||||||
program-name
|
program-name
|
||||||
|
@ -404,6 +408,70 @@ WIDTH columns."
|
||||||
(and=> (package-description p) description->recutils))
|
(and=> (package-description p) description->recutils))
|
||||||
(newline port))
|
(newline port))
|
||||||
|
|
||||||
|
(define (string->generations str)
|
||||||
|
"Return the list of generations matching a pattern in STR. This function
|
||||||
|
accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."
|
||||||
|
(define (maybe-integer)
|
||||||
|
(let ((x (string->number str)))
|
||||||
|
(and (integer? x)
|
||||||
|
x)))
|
||||||
|
|
||||||
|
(define (maybe-comma-separated-integers)
|
||||||
|
(let ((lst (delete-duplicates
|
||||||
|
(map string->number
|
||||||
|
(string-split str #\,)))))
|
||||||
|
(and (every integer? lst)
|
||||||
|
lst)))
|
||||||
|
|
||||||
|
(cond ((maybe-integer)
|
||||||
|
=>
|
||||||
|
list)
|
||||||
|
((maybe-comma-separated-integers)
|
||||||
|
=>
|
||||||
|
identity)
|
||||||
|
((string-match "^([0-9]+)\\.\\.([0-9]+)$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(let ((s (string->number (match:substring match 1)))
|
||||||
|
(e (string->number (match:substring match 2))))
|
||||||
|
(and (every integer? (list s e))
|
||||||
|
(<= s e)
|
||||||
|
(iota (1+ (- e s)) s)))))
|
||||||
|
((string-match "^([0-9]+)\\.\\.$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(let ((s (string->number (match:substring match 1))))
|
||||||
|
(and (integer? s)
|
||||||
|
`(>= ,s)))))
|
||||||
|
((string-match "^\\.\\.([0-9]+)$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(let ((e (string->number (match:substring match 1))))
|
||||||
|
(and (integer? e)
|
||||||
|
`(<= ,e)))))
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
|
(define (string->duration str)
|
||||||
|
"Return the duration matching a pattern in STR. This function accepts the
|
||||||
|
following patterns: \"1d\", \"1w\", \"1m\"."
|
||||||
|
(define (hours->duration hours match)
|
||||||
|
(make-time time-duration 0
|
||||||
|
(* 3600 hours (string->number (match:substring match 1)))))
|
||||||
|
|
||||||
|
(cond ((string-match "^([0-9]+)d$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(hours->duration 24 match)))
|
||||||
|
((string-match "^([0-9]+)w$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(hours->duration (* 24 7) match)))
|
||||||
|
((string-match "^([0-9]+)m$" str)
|
||||||
|
=>
|
||||||
|
(lambda (match)
|
||||||
|
(hours->duration (* 24 30) match)))
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
|
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
|
||||||
"A wrapper on top of `args-fold' that does proper user-facing error
|
"A wrapper on top of `args-fold' that does proper user-facing error
|
||||||
reporting."
|
reporting."
|
||||||
|
|
|
@ -81,6 +81,10 @@ then
|
||||||
"name: hello"
|
"name: hello"
|
||||||
test "`guix package -s "n0t4r341p4ck4g3"`" = ""
|
test "`guix package -s "n0t4r341p4ck4g3"`" = ""
|
||||||
|
|
||||||
|
# List generations.
|
||||||
|
test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \
|
||||||
|
= " guile-bootstrap"
|
||||||
|
|
||||||
# Remove a package.
|
# Remove a package.
|
||||||
guix package --bootstrap -p "$profile" -r "guile-bootstrap"
|
guix package --bootstrap -p "$profile" -r "guile-bootstrap"
|
||||||
test -L "$profile-3-link"
|
test -L "$profile-3-link"
|
||||||
|
|
85
tests/ui.scm
85
tests/ui.scm
|
@ -20,6 +20,7 @@
|
||||||
(define-module (test-ui)
|
(define-module (test-ui)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64))
|
||||||
|
|
||||||
;; Test the (guix ui) module.
|
;; Test the (guix ui) module.
|
||||||
|
@ -64,6 +65,90 @@ interface, and powerful string processing.")
|
||||||
10)
|
10)
|
||||||
#\newline))
|
#\newline))
|
||||||
|
|
||||||
|
(test-equal "integer"
|
||||||
|
'(1)
|
||||||
|
(string->generations "1"))
|
||||||
|
|
||||||
|
(test-equal "comma-separated integers"
|
||||||
|
'(3 7 1 4 6)
|
||||||
|
(string->generations "3,7,1,4,6"))
|
||||||
|
|
||||||
|
(test-equal "closed range"
|
||||||
|
'(4 5 6 7 8 9 10 11 12)
|
||||||
|
(string->generations "4..12"))
|
||||||
|
|
||||||
|
(test-equal "closed range, equal endpoints"
|
||||||
|
'(3)
|
||||||
|
(string->generations "3..3"))
|
||||||
|
|
||||||
|
(test-equal "indefinite end range"
|
||||||
|
'(>= 7)
|
||||||
|
(string->generations "7.."))
|
||||||
|
|
||||||
|
(test-equal "indefinite start range"
|
||||||
|
'(<= 42)
|
||||||
|
(string->generations "..42"))
|
||||||
|
|
||||||
|
(test-equal "integer, char"
|
||||||
|
#f
|
||||||
|
(string->generations "a"))
|
||||||
|
|
||||||
|
(test-equal "comma-separated integers, consecutive comma"
|
||||||
|
#f
|
||||||
|
(string->generations "1,,2"))
|
||||||
|
|
||||||
|
(test-equal "comma-separated integers, trailing comma"
|
||||||
|
#f
|
||||||
|
(string->generations "1,2,"))
|
||||||
|
|
||||||
|
(test-equal "comma-separated integers, chars"
|
||||||
|
#f
|
||||||
|
(string->generations "a,b"))
|
||||||
|
|
||||||
|
(test-equal "closed range, start > end"
|
||||||
|
#f
|
||||||
|
(string->generations "9..2"))
|
||||||
|
|
||||||
|
(test-equal "closed range, chars"
|
||||||
|
#f
|
||||||
|
(string->generations "a..b"))
|
||||||
|
|
||||||
|
(test-equal "indefinite end range, char"
|
||||||
|
#f
|
||||||
|
(string->generations "a.."))
|
||||||
|
|
||||||
|
(test-equal "indefinite start range, char"
|
||||||
|
#f
|
||||||
|
(string->generations "..a"))
|
||||||
|
|
||||||
|
(test-equal "duration, 1 day"
|
||||||
|
(make-time time-duration 0 (* 3600 24))
|
||||||
|
(string->duration "1d"))
|
||||||
|
|
||||||
|
(test-equal "duration, 1 week"
|
||||||
|
(make-time time-duration 0 (* 3600 24 7))
|
||||||
|
(string->duration "1w"))
|
||||||
|
|
||||||
|
(test-equal "duration, 1 month"
|
||||||
|
(make-time time-duration 0 (* 3600 24 30))
|
||||||
|
(string->duration "1m"))
|
||||||
|
|
||||||
|
(test-equal "duration, 1 week == 7 days"
|
||||||
|
(string->duration "1w")
|
||||||
|
(string->duration "7d"))
|
||||||
|
|
||||||
|
(test-equal "duration, 1 month == 30 days"
|
||||||
|
(string->duration "1m")
|
||||||
|
(string->duration "30d"))
|
||||||
|
|
||||||
|
(test-equal "duration, integer"
|
||||||
|
#f
|
||||||
|
(string->duration "1"))
|
||||||
|
|
||||||
|
(test-equal "duration, char"
|
||||||
|
#f
|
||||||
|
(string->duration "d"))
|
||||||
|
|
||||||
(test-end "ui")
|
(test-end "ui")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue