From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: Re: New =?utf-8?Q?=E2=80=98--list-generations=E2=80=99?= and =?utf-8?Q?=E2=80=98--delete-generations=E2=80=99?= options Date: Fri, 13 Sep 2013 18:44:34 +0400 Message-ID: <87zjrgok6l.fsf@karetnikov.org> References: <87vc2o4qwc.fsf@gnu.org> <87bo4fcbcz.fsf@karetnikov.org> <878uzj6nev.fsf@gnu.org> <877gf1yftq.fsf@karetnikov.org> <87bo4dspl2.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> 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]:53883) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VKUXT-00089A-Re for guix-devel@gnu.org; Fri, 13 Sep 2013 10:40:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VKUXO-0002qc-MT for guix-devel@gnu.org; Fri, 13 Sep 2013 10:40:03 -0400 In-Reply-To: <87zjrins47.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Thu, 12 Sep 2013 14:26:16 +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 > I=E2=80=99d prefer clearer case analysis as shown above. OK, what do you think about this diff? If everything is fine, I=E2=80=99ll= make it output generations in the recutils format. (Is it necessary to mention that =E2=80=98maybe-comma-separated-integers=E2= =80=99 accepts something like =E2=80=981,2,3,=E2=80=99 or =E2=80=981,,,2=E2=80=99. Or sho= uld I change the function?) I don=E2=80=99t know if the code works with non-default profiles because my store is broken. When I try to install or build a new package (with or without substitutes), I get the following message: guix package: error: build failed: getting attributes of path `/nix/store/f= cwh19ljibqjfx0c3cwnwcc7p31aq227-glibc-2.17-locales': No such file or direct= ory I=E2=80=99ve already tried to run =E2=80=98guix gc=E2=80=99, but it didn=E2= =80=99t help. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=list-generations.diff Content-Transfer-Encoding: quoted-printable diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1393ca3..6e8171c 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,127 @@ all of PACKAGES, a list of name/version/output/path/d= eps tuples." (switch-link))) (else (switch-link))))) ; anything else =20 +(define (string->generations str) + "Return a 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 + (delete "" (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 a 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) + =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* (available-generations str #:optional (profile %current-profile)) + "Return a list of available generations matching pattern in STR. See +'string->generations' and 'string->duration' for a list of valid patterns." + (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 an alist of dates and generations. + (map (lambda (x) + (cons (and=3D> (stat (format #f "~a-~a-link" + profile (number->string x))) + stat:ctime) + x)) + (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 +563,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 +625,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 +1008,24 @@ 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:~%" (number->string number)) + (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)))))) + + (let ((lst (if (string-null? regexp) + (generation-numbers profile) + (or (available-generations regexp profile) + (leave (_ "invalid syntax: ~a~%") regexp))))) + (for-each list-generation lst))) + (('list-installed regexp) (let* ((regexp (and regexp (make-regexp regexp))) (manifest (profile-manifest profile)) --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJSMyTUAAoJEM+IQzI9IQ38BCwP/i1YmdUcmAOkLU970i6qEAL+ TLQVYMs96RjK8egU8a9C+Xsk2h2A1pWZRgfnn44dOvbKED0Bz1R7lCsFObYewehd O2Qbj9Ae2mKWDXBAK4DOY+AqzJadBHSrF71oesbq55gXvIMk1bqhzyOfZYW9T8Mz Ny0x2GsZZco8oKj9X6QQwludx5M2apJOgbaHT8syxosx/5EsvI3jkZzf4gzHptZw +K3H8goV23OjHnrYxX2ZhLDLsaNdQ3mAt+VnBOvz0X3snQXLS/7cX4RMthq/h111 zTLVzRJCmlzNBTE/Faz9FmsBNKwjmH+SULqbv2+y8piv+WG/QESITkeHuBTPzLuF VD45hdltqRJcI3v8iosNoBJzKvylgRMHBXm5WLA2LhkYiFEiBQFK0b2ES2xwKj+z 9yPT7YAiuwbgxsVCtFtY3Is2ngqlI6/uulL1OGYk1K16qssqga8FsQm6zU/JaKuL dHCBsBiaFcqEvk+MzBjgZgg6HWYSU9y+rKLqNlzRXVjIC/x4lYcjWqeueEq2VRUs UungStU1TOM0cFn19MFJSLcEG19/YlEAcWwKNnmf5ivw3MJUrB1fpeBoBbtO56/o pQ2mg6m+gHZvh2yYF7jTaTlTjV9OnzEo7/4d6vhmtY/sjLWjgSQ9sK5W0WHyKQKl 5SSSw0OT9euBBlC3Kykd =ndDl -----END PGP SIGNATURE----- --==-=-=--