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: Thu, 05 Sep 2013 05:30:12 +0400 Message-ID: <87bo48xdgb.fsf@karetnikov.org> References: <87vc2o4qwc.fsf@gnu.org> <87y57kljro.fsf@karetnikov.org> <87hae81uvo.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> 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]:33537) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VHOKP-00009R-So for guix-devel@gnu.org; Wed, 04 Sep 2013 21:25:47 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VHOKO-0005lf-4E for guix-devel@gnu.org; Wed, 04 Sep 2013 21:25:45 -0400 In-Reply-To: <87eh97616m.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Mon, 02 Sep 2013 11:08:17 +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 The attached procedure will be invoked when either option is called with an argument. It returns an empty list if the argument is not valid. Or when the needed generation can=E2=80=99t be found. Do you see any problems? Please check everything (especially the =E2=80=98first-month=E2=80=99 and =E2=80=98last-month=E2=80=99 functions). --=-=-= Content-Disposition: attachment; filename=avail-generations.scm (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-26) (ice-9 regex) (ice-9 optargs)) (define profile-numbers (@@ (guix scripts package) profile-numbers)) (define %current-profile (@@ (guix scripts package) %current-profile)) ;; XXX: (avail-generations "") returns () (because of (csi)). This case ;; should be handled by a different procedure. Basically, it means that no ;; arguments were passed to '--list-generations' or '--delete-generations'. (define* (avail-generations str #:optional (profile %current-profile)) "Return a list of generations matching the pattern in STR." (define (valid-gen? n) ;; Is N a valid generation number? (any (cut = n <>) (profile-numbers profile))) (define (valid-gens lst) ;; Return a list of valid generation numbers. (fold-right (lambda (x lst) (if (valid-gen? x) (cons x lst) lst)) '() lst)) (define (int) ;; Does STR contain an integer? (let ((x (string->number str))) (and (integer? x) (valid-gen? x) (list x)))) (define (csi) ;; Does STR contain comma-separated integers? ;; XXX: Should it handle spaces? ;; ;; (let* ((str* (string-concatenate (string-split str #\space))) ;; (lst (map string->number (delete "" (string-split str* #\,))))) ;; ;; The uncommented version returns '() for "1,2 ", "2, 3", "2 ,3", etc. ;; (The other procedures don't handle similar cases too.) (let ((lst (delete-duplicates (map string->number (delete "" (string-split str #\,)))))) (and (every integer? lst) (valid-gens lst)))) (define (safe-match:substring->number match n) (false-if-exception (string->number (match:substring match n)))) (define (whole-range) (let* ((rx (make-regexp "^([0-9]+)\\.\\.([0-9]+)$")) (res (regexp-exec rx str)) (x (safe-match:substring->number res 1)) (y (safe-match:substring->number res 2))) (and (every integer? (list x y)) (<= x y) ; in Haskell, [1..1] => [1] (valid-gens (iota (1+ (- y x)) x))))) (define (start-range) (let* ((rx (make-regexp "^([0-9]+)\\.\\.$")) (res (regexp-exec rx str)) (x (safe-match:substring->number res 1))) (and (integer? x) (drop-while (cut > x <>) ;; XXX: Is it really necessary to sort? (sort (profile-numbers profile) <))))) (define (end-range) (let* ((rx (make-regexp "^\\.\\.([0-9]+)$")) (res (regexp-exec rx str)) (x (safe-match:substring->number res 1))) (and (integer? x) (valid-gens (iota x 1))))) (define dates-gens ;; Return an alist of dates and generations. (map (lambda (x) (cons (and=> (stat (format #f "~a-~a-link" ;; XXX: Should I check that ;; 'number->string's argument is ;; actually a number? Can I ;; trust 'profile-numbers'? profile (number->string x))) stat:ctime) x)) ;; XXX: Is there a need to sort? (sort (profile-numbers profile) <))) (define dates (fold-right (lambda (x lst) (cons (first x) lst)) '() dates-gens)) (define (first-month) (let ((x (+ (apply min dates) (* 30 86400)))) ; add 30 days (and (string=? "first-month" str) (map (cut assoc-ref dates-gens <>) (filter (cut >= x <>) dates))))) (define (last-month) (let ((x (- (apply max dates) (* 30 86400)))) ; subtract 30 days (and (string=? "last-month" str) (map (cut assoc-ref dates-gens <>) (filter (cut <= x <>) dates))))) (or (int) (csi) (whole-range) (start-range) (end-range) (first-month) (last-month) '())) ;;; ;;; Valid syntax. ;;; (for-each (lambda (x) (display (avail-generations x)) (newline)) (list "1" "6" "12" "3," "4,4" "2,3" "4,5,1,2" "3,2,3," "1..3" "2..4" "1..11" "3..3" "12..12" "1.." "3.." "13.." "..1" "..7" "..14" "first-month" "last-month")) --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJSJ96nAAoJEM+IQzI9IQ38IdYP/1rqHF+66MjfcZwHLYno8TRS ixRauXSKxnvvt22TITws1duma+bq0gc3+k52+3YFZqGk7fpG2Bs3ditiyAh4w3pQ i6/p2lstBdnFRFn9Kgz0J+cYhj5lIzA7RxbH4RwOU1QjCcDIbaakw0JfuK256ncR GuVgG9C4ZgNnNS7AW3aIMB5u8R6iduHEyeKSVYGfHxVqSmSjSMgtwyTnIN3I2obi Pts8iDbpFUt8pmNYE/uvLgreuy93REdljhCSW5ZBanpUut/MsmdWPb9n8CO6cGZW lVqJN8EKVYIf9Q7fcdIXR4Xsg9oM4t350rLeQGKGhHW47nlM1ZRelUivoDgwTKKB FTM2lrjLZl4/a//uTbQ7PQY1hvKx50SLLiXvdOPd8RpzgT0jrh/ZVFxkAEIWrQz/ URT8Oi+NUvlC2kXO6kAc0/4/TqOf2vHoWVpRF5/cYPQ/cCPNdoL8sR2ITaOi10p3 5E5rnozRBfsw/gDgOSHU2VbVqsMVqJnLvoaf6sM1b21z5VMTwIdxd7DCdOppmey6 eAzB7EQHeQ9YWaLiqCY7ahbgOM1IWnvZKXxOmZpy4jaoUmIcVGg+gQ5yoNOvY1f5 8kOTwD9dJR8cb3jJNd9CVEf545/KznPFxSBAPz55Xni+a7jCKoPkPB+GTs0LnXKQ gAdafjZgW8Y3sJkkbL6g =7gaC -----END PGP SIGNATURE----- --==-=-=--