From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: PRELIMINARY: [PATCH] guix package: Add '--list-generations'. Date: Wed, 18 Sep 2013 04:43:28 +0400 Message-ID: <87d2o7q7rj.fsf@karetnikov.org> References: <87vc2o4qwc.fsf@gnu.org> <87a9jxeh05.fsf@gnu.org> <87r4d9r2lv.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> 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]:44686) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VM5nD-00058c-L0 for guix-devel@gnu.org; Tue, 17 Sep 2013 20:38:58 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VM5nA-000286-L8 for guix-devel@gnu.org; Tue, 17 Sep 2013 20:38:55 -0400 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 > I think it=E2=80=99s reasonable to have a first milestone without recutils > output. OK. > Not sure what you mean by =E2=80=9Ctwo record sets=E2=80=9D. =E2=80=9CYou can have two record sets: one for generations, one for packages.=E2=80=9D=C2=A0[1] > I see two use cases: one where you just want human-friendly output, for > when one is glancing at the available generations, and one that is more > amenable to Unix pipelines for post-processing. Recutils output is for > the latter case. Right. >> I still think that someone may benefit from the recutils format. So >> let=E2=80=99s allow the =E2=80=98recutils=E2=80=99 argument that would l= ist all generations in >> that format [1] and use the following format [2] for everything else: >> >> generation 1 Dec 16 2013 >> guile 2.0.7 out,debug gnu/packages/guile.scm >> hello 2.8 out gnu/packages/base.scm >> >> generation 2 May 7 2013 >> guile 2.0.9 out gnu/packages/guile.scm >> >> Is it OK? > Yes. >> Should it point to the store instead of (gnu packages =E2=80=A6)? > Yes, I think so. Done. >> Why do you suggest to put =E2=80=98string->duration=E2=80=99 into (guix = ui)? > Because it=E2=80=99s a user-interface function. Done. However, I think it would be better to write more generic procedures if we want to place them in separate modules, so they can be reused. (I can replace the current version with a more generic one if you want.) >> I installed Nix 1.5.3. and ran the command: >> >> error: setting synchronous mode: unable to open database file > Problem with permissions on the SQLite database, I guess. I =E2=80=9Cfixed=E2=80=9D it by deleting the store and reinstalling Guix. 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 fourth generation is shown twice in the former case. Other issues: 1. =E2=80=98false-if-exception=E2=80=99 in =E2=80=98generation-ctime=E2=80= =99. 2. A race condition (marked with XXX). 3. =E2=80=98guix package -l -p test=E2=80=99 returns =E2=80=98guix package:= error: test: extraneous argument=E2=80=99. (However, the same happens with =E2=80=98= -I=E2=80=99.) 4. There must be a better way to write the test in =E2=80=98tests/guix-package.sh=E2=80=99. [1] https://lists.gnu.org/archive/html/guix-devel/2013-08/msg00173.html --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-guix-package-Add-list-generations.patch Content-Transfer-Encoding: quoted-printable From=2027e73d3d86ca7abfbc470f3561c059d730314821 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Tue, 17 Sep 2013 23:56:10 +0000 Subject: [PATCH] guix package: Add '--list-generations'. * guix/scripts/package.scm: Import (srfi srfi-19). (generation-ctime, 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 | 36 +++++++++++++++++ guix/scripts/package.scm | 100 ++++++++++++++++++++++++++++++++++++++++++= ++++ guix/ui.scm | 68 +++++++++++++++++++++++++++++++ tests/guix-package.sh | 4 ++ tests/ui.scm | 85 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 293 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 5d1b780..ebf80b4 100644 =2D-- a/doc/guix.texi +++ b/doc/guix.texi @@ -606,6 +606,42 @@ 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{regexp}] +@itemx -l [@var{regexp}] +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{regexp} is used, the command returns only matching +generations. Valid patterns include: + +@itemize +@item @emph{Integers and comma-separated integers}. Both patterns will si= mply +return the corresponding generations. For instance, +@code{--list-generations=3D1} will return the first one. + +If you pass @code{--list-generations=3D1,8,2}, the command will return +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..0d3cc05 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,66 @@ all of PACKAGES, a list of name/version/output/path/de= ps tuples." (switch-link))) (else (switch-link))))) ; anything else =20 +(define (generation-ctime profile number) + "Return the creation date of a generation or #f if it does not exist." + (false-if-exception + (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 dates-generations + ;; Return the alist of dates and generations. + (map (lambda (number) + (cons (generation-ctime profile number) + number)) + (generation-numbers profile))) + + (define dates + (fold-right (lambda (x acc) + (cons (first x) acc)) + '() + dates-generations)) + + (match duration + (#f #f) + (res + (let ((s (time-second (subtract-duration (current-time) duration)))) + (map (cut assoc-ref dates-generations <>) + (filter (cut <=3D s <>) dates)))))) + + (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 +502,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[=3DREGEXP] + list generations matching REGEXP")) (newline) (display (_ " -p, --profile=3DPROFILE use PROFILE instead of the user's default profi= le")) @@ -500,6 +564,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 +947,38 @@ more information.~%")) ;; actually processed, #f otherwise. (let ((profile (assoc-ref opts 'profile))) (match (assoc-ref opts 'query) + (('list-generations regexp) + (define (list-generation number) + (begin + (format #t "Generation ~a\t~a~%" number + (date->string + (time-utc->date + (make-time time-utc 0 + (generation-ctime 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? regexp) + (for-each list-generation + (generation-numbers profile))) + ((matching-generations regexp profile) + =3D> + (cut for-each list-generation <>)) + (else + (leave (_ "invalid syntax: ~a~%") + regexp))) + #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..adba9f9 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 "infinite end range" + '(>=3D 7) + (string->generations "7..")) + +(test-equal "infinite 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 "infinite end range, char" + #f + (string->generations "a..")) + +(test-equal "infinite 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) iQIcBAEBAgAGBQJSOPczAAoJEM+IQzI9IQ38broP/RdXlwGiGmh2piFtx+d/xaRP M0N8BGSVBcqWIDTIWMlD8FFqDvHhxUzCaC1eLhIwnLKcpJ1GbjURR+B/sXmr9oYA gSAVvL7Ivl6y5eNR6VVIvHG5dRIYUHVmRVaAOcOOFhSXZjVYh5XmZl2VU+ffpRvv P6yCjzIbtrnqqbgspxPDgDH/qoYdV2UJkG44brg1mryFhR7AUCCzOT/6ev+TXjLa meVcbTqCTMYX/W18Qf/fl4DD88kVvcmeEDIw/KOlJvbsXexPSbV5ZT0IcGqYgjWK 26qaZyw2iiptcZ47nwS9u1qcmnx3sXXnoye9QrSzZHglTyygKTK339iwB3C0YyuH QaEWZSQOrlRWP/CFxVgUvR81/24asvF3SuI0PT9TUC5vYnw/DkYryaIchINcijD2 yC0qxaEetuBZhv2GBYM1qtMGzVCcj68J/8vj5FVE9YbGlUmX767JMJao9R2M5sYt O3VaYppKhUu+P5PKru2faSH+OHmV8mSQu0Eb9KFpgaGLZoRDzRkai48w7tcxDbAl Ooa+8Ok42qnZMekUeL1L/g/Hh7qQD7g5riMQSAreBUiYsFa+119JREIkPz+9w8Dg HL4xP7YxCNsPLgnfDKfo5aWEiw1RMqYCr6xC7Wlc6Y+lpcUuKGhtT1rF2raqmeKM QKea3vwonJfZGBSIzOn9 =fHFp -----END PGP SIGNATURE----- --==-=-=--