From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: [PATCH] guix package: Add '--list-generations'. Date: Thu, 19 Sep 2013 04:49:20 +0400 Message-ID: <87eh8l63fz.fsf_-_@karetnikov.org> References: <87vc2o4qwc.fsf@gnu.org> <874na4jfp4.fsf_-_@karetnikov.org> <87eh97616m.fsf@gnu.org> <87bo48xdgb.fsf@karetnikov.org> <87hadz9gze.fsf@gnu.org> <87fvtjdl7y.fsf@karetnikov.org> <87bo444e9q.fsf@gnu.org> <87fvtfzihg.fsf@karetnikov.org> <87ioybxdun.fsf@gnu.org> <877geq9wx6.fsf@karetnikov.org> <87zjrmgcjh.fsf@gnu.org> <87ob80os3c.fsf@karetnikov.org> <87li336ofs.fsf@gnu.org> <87wqmmxutb.fsf@karetnikov.org> <87zjrins47.fsf@gnu.org> <87zjrgok6l.fsf@karetnikov.org> <8738p8wgun.fsf@gnu.org> <87k3ihyq8a.fsf@karetnikov.org> <87ob7tm05z.fsf@gnu.org> <87d2o7q7rj.fsf@karetnikov.org> <87mwn924uc.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:50783) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VMSMQ-00015v-Il for guix-devel@gnu.org; Wed, 18 Sep 2013 20:44:49 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VMSMN-0006KC-Hg for guix-devel@gnu.org; Wed, 18 Sep 2013 20:44:46 -0400 In-Reply-To: <87mwn924uc.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Wed, 18 Sep 2013 23:32:43 +0200") List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: guix-devel@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable > Ah so I was referring to recutils record sets (I thought you were > talking about SRFI-9 records or something.) So what=E2=80=99s the questi= on? > :-) I was trying to explain why we shouldn=E2=80=99t always output generations = in the recutils format. It works for =E2=80=98--search=E2=80=99 because there= =E2=80=99s only one record. >> I=E2=80=99m attaching the patch. Please don=E2=80=99t push it yet. I= =E2=80=99ve just found a >> bug. On my machine, =E2=80=98guix package -p test -l 2d=E2=80=99 and = =E2=80=98guix package -p >> test -l=E2=80=99 should return the same set of generations, but the four= th >> generation is shown twice in the former case. > OK. Fixed, but I found a new one. We output a human-readable date but filter generations based on =E2=80=98ctime=E2=80=99. This may cause proble= ms in some cases. Let me try to demonstrate the problem. $ ./pre-inst-env guix package -p test -l Generation 1 Sep 16 2013 Generation 2 Sep 16 2013 Generation 3 Sep 16 2013 Generation 4 Sep 16 2013 Generation 5 Sep 16 2013 Generation 6 Sep 17 2013 And the last two days: $ ./pre-inst-env guix package -p test -l 2d Generation 2 Sep 16 2013 Generation 3 Sep 16 2013 Generation 4 Sep 16 2013 Generation 5 Sep 16 2013 Generation 6 Sep 17 2013 See? Even though the first five generations have the same date, the first one is not shown. I believe that this bug is now fixed. I incorporated all your suggestions except the following ones. > I=E2=80=99d use @table rather than @itemize. IIUC, it can be used only with the following commands: =E2=80=9C@code, @sam= p, @var, @option, or @kbd.=E2=80=9D [1] Neither command seems to match. > s/If you pass/Passing/ > s/will return/specifies/ This doesn=E2=80=99t sound right because the other sentences use =E2=80=9Cw= ill.=E2=80=9D Can I push the attached patch to =E2=80=98master=E2=80=99? [1] https://gnu.org/software/texinfo/manual/texinfo/texinfo.html#index-table --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-guix-package-Add-list-generations.patch Content-Transfer-Encoding: quoted-printable From=2065a2d978e1b74cde953e81109dad33f2562e8294 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 19 Sep 2013 00:36:05 +0000 Subject: [PATCH] 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'. =2D-- doc/guix.texi | 33 ++++++++++++++ guix/scripts/package.scm | 107 ++++++++++++++++++++++++++++++++++++++++++= ++++ guix/ui.scm | 68 +++++++++++++++++++++++++++++ tests/guix-package.sh | 4 ++ tests/ui.scm | 85 ++++++++++++++++++++++++++++++++++++ 5 files changed, 297 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 5d1b780..680e629 100644 =2D-- a/doc/guix.texi +++ b/doc/guix.texi @@ -606,6 +606,39 @@ library are installed in the profile, then @code{--sea= rch-paths} will suggest setting these variables to @code{@var{profile}/include} and @code{@var{profile}/lib}, respectively. =20 +@item --list-generations[=3D@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=3D1} will +return the first one. + +And @code{--list-generations=3D1,8,2} will output three generations in the +specified order. Neither spaces nor trailing commas are allowed. + +@item @emph{Ranges}. @code{--list-generations=3D2..9} will print 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=3D2..}, will output all generations starting from +the second one. + +@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, wee= ks, +or months by passing an integer along with the first letter of the +duration, e.g., @code{--list-generations=3D20d}. +@end itemize + @item --profile=3D@var{profile} @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1393ca3..1cff9b0 100644 =2D-- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -34,6 +34,7 @@ #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) @@ -246,6 +247,74 @@ all of PACKAGES, a list of name/version/output/path/de= ps tuples." (switch-link))) (else (switch-link))))) ; anything else =20 +(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 pattern= s." + (define (valid-generations lst) + (define (valid-generation? n) + (any (cut =3D n <>) (generation-numbers profile))) + + (fold-right (lambda (x acc) + (if (valid-generation? x) + (cons x acc) + acc)) + '() + lst)) + + (define (filter-generations generations) + (match generations + (() '()) + (('>=3D n) + (drop-while (cut > n <>) + (generation-numbers profile))) + (('<=3D 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 (<=3D s (cdr x)) + (first x))) + generation-ctime-alist)))))) + + (cond ((string->generations str) + =3D> + filter-generations) + ((string->duration str) + =3D> + filter-by-duration) + (else #f))) + (define (find-packages-by-description rx) "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of matching packages." @@ -441,6 +510,9 @@ Install, remove, or upgrade PACKAGES in a single transa= ction.\n")) --roll-back roll back to the previous generation")) (display (_ " --search-paths display needed environment variable definitions")) + (display (_ " + -l, --list-generations[=3DPATTERN] + list generations matching PATTERN")) (newline) (display (_ " -p, --profile=3DPROFILE use PROFILE instead of the user's default profi= le")) @@ -500,6 +572,10 @@ Install, remove, or upgrade PACKAGES in a single trans= action.\n")) (option '("roll-back") #f #f (lambda (opt name arg 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 (lambda (opt name arg result) (cons `(query search-paths) result))) @@ -879,6 +955,37 @@ more information.~%")) ;; actually processed, #f otherwise. (let ((profile (assoc-ref opts 'profile))) (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")) + (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) + =3D> + (cut for-each list-generation <>)) + (else + (leave (_ "invalid syntax: ~a~%") + pattern))) + #t) + (('list-installed regexp) (let* ((regexp (and regexp (make-regexp regexp))) (manifest (profile-manifest profile)) diff --git a/guix/ui.scm b/guix/ui.scm index 720d01b..a3289b4 100644 =2D-- a/guix/ui.scm +++ b/guix/ui.scm @@ -28,12 +28,14 @@ #:use-module ((guix licenses) #:select (license? license-name)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 regex) #:export (_ N_ leave @@ -50,6 +52,8 @@ fill-paragraph string->recutils package->recutils + string->generations + string->duration args-fold* run-guix-command program-name @@ -404,6 +408,70 @@ WIDTH columns." (and=3D> (package-description p) description->recutils)) (newline port)) =20 +(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) + =3D> + list) + ((maybe-comma-separated-integers) + =3D> + identity) + ((string-match "^([0-9]+)\\.\\.([0-9]+)$" str) + =3D> + (lambda (match) + (let ((s (string->number (match:substring match 1))) + (e (string->number (match:substring match 2)))) + (and (every integer? (list s e)) + (<=3D s e) + (iota (1+ (- e s)) s))))) + ((string-match "^([0-9]+)\\.\\.$" str) + =3D> + (lambda (match) + (let ((s (string->number (match:substring match 1)))) + (and (integer? s) + `(>=3D ,s))))) + ((string-match "^\\.\\.([0-9]+)$" str) + =3D> + (lambda (match) + (let ((e (string->number (match:substring match 1)))) + (and (integer? e) + `(<=3D ,e))))) + (else #f))) + +(define (string->duration str) + "Return the duration matching a pattern in STR. This function accepts t= he +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) + =3D> + (lambda (match) + (hours->duration 24 match))) + ((string-match "^([0-9]+)w$" str) + =3D> + (lambda (match) + (hours->duration (* 24 7) match))) + ((string-match "^([0-9]+)m$" str) + =3D> + (lambda (match) + (hours->duration (* 24 30) match))) + (else #f))) + (define (args-fold* options unrecognized-option-proc operand-proc . seeds) "A wrapper on top of `args-fold' that does proper user-facing error reporting." diff --git a/tests/guix-package.sh b/tests/guix-package.sh index ee186ea..f8596fa 100644 =2D-- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -81,6 +81,10 @@ then "name: hello" test "`guix package -s "n0t4r341p4ck4g3"`" =3D "" =20 + # List generations. + test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1= `" \ + =3D " guile-bootstrap" + # Remove a package. guix package --bootstrap -p "$profile" -r "guile-bootstrap" test -L "$profile-3-link" diff --git a/tests/ui.scm b/tests/ui.scm index 0b6f3c5..3d5c3e7 100644 =2D-- a/tests/ui.scm +++ b/tests/ui.scm @@ -20,6 +20,7 @@ (define-module (test-ui) #:use-module (guix ui) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-64)) =20 ;; Test the (guix ui) module. @@ -64,6 +65,90 @@ interface, and powerful string processing.") 10) #\newline)) =20 +(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" + '(>=3D 7) + (string->generations "7..")) + +(test-equal "indefinite start range" + '(<=3D 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 =3D=3D 7 days" + (string->duration "1w") + (string->duration "7d")) + +(test-equal "duration, 1 month =3D=3D 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") =20 =2D-=20 1.7.9.5 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJSOkoTAAoJEM+IQzI9IQ38kCgP/imM0iaHnLDZzzBVeGOkIdgD wNZulblpxBQloreir6DBpEipPuWocHRRnvJ+VJ221UqJYRF5IFCvX6jew+f+NuZM FGEaH+qtY1BODS1iWfBacHa0MOazsSsibCwXZVPG+9biBuuDGKV+e6WmBRsrdBjt 0Y9cEpPqAFxgi2vaM6V2CJxIMkPGjulJ+WUVnQL48F6qlBXoFTG5YbfI9JddaR74 L52I7hGGxMgjaR5VazdBBp1DLYS8hmHsHDT3Z8MFehP+jkg52eyP11Xq3NcFrGYM 4dDJ3qXehmxQPfFWROVhzrN7E4qdhXHDTqGT7DU3lIcHPdPgiYEps9xrechT4boD MlFNABVOYiBBZhYyNCsi2fnO0fggKIOBlEB9RJImciUevyRtH72xS5yeXYd0IBfN aNhGdRel7i05S0Qxm/8esSzKdkyYisDUQXnHr7bT0ygM0le9cnH20t2SV8WIjZdN f6tWrf+p6kIYwdHB+byUQLBGe8QVlC+FQ9jGq0o3caCRHVFdjIMJMrIyGOvhNhqp T9QxwDipR+U6TbBbUpxcjfYfmWKer66tesOYQw99CfCttU0DcH13ljKawoYbU9U7 rba862TW3zzEQJKD2XVT8W9l35yykz7rmrqPLbg9FdNQCF43SZ0gNBeiYcLWqsfy VM69W8bf+JAif0rtUDX9 =V0Km -----END PGP SIGNATURE----- --==-=-=--