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, 12 Sep 2013 13:17:52 +0400 Message-ID: <87wqmmxutb.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> <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> 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]:41202) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VK2xp-0005j1-GS for guix-devel@gnu.org; Thu, 12 Sep 2013 05:13:30 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VK2xk-00037h-KD for guix-devel@gnu.org; Thu, 12 Sep 2013 05:13:25 -0400 In-Reply-To: <87li336ofs.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Wed, 11 Sep 2013 23:25:27 +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 > By definition submatches 1 and 2 exist when RES is true. > Thus, I=E2=80=99d remove =E2=80=98safe-match:substring->number=E2=80=99 a= nd do: > (match (string-match "^([0-9]+)\\.\\.([0-9]+)$" str) > (#f #f) > (matches > (let ((start (number->string (match:substring matches 1))) > (end (number->string (match:substring matches 2)))) > ...))) Done. > Probably this can reduce to a big =E2=80=98cond=E2=80=99, which would be = even more > readable: > (cond ((maybe-integer) > =3D> > list) > ((string-match "^([0-9]+)\\.\\.([0-9]+)$" str) > =3D> > (lambda (match) > ...)) > ...) Are you sure? I haven=E2=80=99t found a way to make =E2=80=98cond=E2=80=99= as readable as =E2=80=98or=E2=80=99. I=E2=80=99m attaching a sketchy version. If you don=E2=80=99t see any prob= lems, I=E2=80=99ll try to integrate this code into =E2=80=98package.scm=E2=80=99. (Something is wrong with the store on my machine, so I can=E2=80=99t proper= ly test the filtering part. But I=E2=80=99ll do it as soon as possible.) --=-=-= Content-Disposition: attachment; filename=avail-generations5.scm (define-module (avail-generations) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (ice-9 regex) #:use-module (ice-9 match)) (define profile-numbers (@@ (guix scripts package) profile-numbers)) (define %current-profile (@@ (guix scripts package) %current-profile)) ;;; ;;; Parsing. ;;; (define (string->generations str) (define (maybe-integer) (let ((x (string->number str))) (and (integer? x) (list x)))) (define (maybe-comma-separated-integers) (let ((lst (delete-duplicates (map string->number (delete "" (string-split str #\,)))))) (and (every integer? lst) lst))) (define (maybe-whole-range) (match (string-match "^([0-9]+)\\.\\.([0-9]+)$" str) (#f #f) (res (let ((s (string->number (match:substring res 1))) (e (string->number (match:substring res 2)))) (and (every integer? (list s e)) (<= s e) (iota (1+ (- e s)) s)))))) (define (maybe-start-range) (match (string-match "^([0-9]+)\\.\\.$" str) (#f #f) (res (let ((s (string->number (match:substring res 1)))) (and (integer? s) `(>= ,s)))))) (define (maybe-end-range) (match (string-match "^\\.\\.([0-9]+)$" str) (#f #f) (res (let ((e (string->number (match:substring res 1)))) (and (integer? e) `(<= ,e)))))) (or (maybe-integer) (maybe-comma-separated-integers) (maybe-whole-range) (maybe-start-range) (maybe-end-range))) (define (string->duration str) (define (maybe-duration hours pattern) (match (string-match pattern str) (#f #f) (res (make-time time-duration 0 (* 3600 hours (string->number (match:substring res 1))))))) (define (days) (maybe-duration 24 "^([0-9]+)d$")) (define (weeks) (maybe-duration (* 24 7) "^([0-9]+)w$")) (define (months) (maybe-duration (* 24 30) "^([0-9]+)m$")) (or (days) (weeks) (months))) ;;; ;;; Filtering. ;;; (define* (available-generations str #:optional (profile %current-profile)) (define (valid-generations lst) (define (valid-gen? n) (any (cut = n <>) (profile-numbers profile))) (fold-right (lambda (x lst) (if (valid-gen? x) (cons x lst) lst)) '() lst)) ;; XXX: find a better name for this function. (define (filter-generations gens) (match gens (() '()) (('>= n) (drop-while (cut > n <>) ;; XXX: is it really necessary to sort? Check ;; 'profile-numbers'. (sort (profile-numbers profile) <))) (('<= n) (valid-generations (iota n 1))) ((lst ..1) (valid-generations lst)) (_ #f))) ;; XXX: find a better name. (define (filter-by-duration dur) (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)) (match dur (#f #f) (res (let ((s (time-second (subtract-duration (current-time) dur)))) (map (cut assoc-ref dates-gens <>) (filter (cut <= s <>) dates)))))) (cond ((string->generations str) => filter-generations) ((string->duration str) => filter-by-duration) (else #f))) ;; XXX: ;; scheme@(avail-generations)> (available-generations "..0") ;; $21 = () --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJSMYbDAAoJEM+IQzI9IQ38DKIP/AlW3IEW3eSg84jOV3+Gbq7S qmdpRWXmRpJqoOpqG5s6DFOyVgZ5pr7ptxRsHi/9hqg5tAcQYQj/maS5GgiV2uYT +F3jiYJod+UoFzM59X8QeueGexRTQolOfxjEf9/6ZvewRnu/OhkAOvQBmuwo7OvA Muh5JQLbDMimOiu2aopcii+8qgoKgs1oyitm7ND/OSWeVOiTJG2BF/BQMPltvgYk srW2iGL3K4EV3dQT9TPqb/m+7w2tMSAliwYITRjSlCGB3Pa+zRwcSvfoQEnNHtTY pqEBvSCTmF+fEYPpAp3vP2TvqGNBYX6Hc5d5QzLgYWyz/kbJ8ScgfzS274KMi1N5 KCRrTOcY+E2Y+i1rNyZaRhuT4mXcoHvDdu8UBtPAjACBdptOiZn/wzyWz8fnFebG 7QimCnVMJqWDfsI53cMduiQgWDE8GWsGLf2OrhNAoRftHnjfcccMMWJ3F9AZKCde px4NjFif6LhD/Y2yajMkxUMfhtwpF4GrbMsN4/V+2UiHnOZsIuB82VoP+g2euxkk dKe9dGF8o0yXIZy7V7LBjiFinrs6EZHrETIrqj1OKIbt0w1HV2EXVYXVT5QJ/Esp uU38LzkYC5vSMB/SLH8AofRNBTvicpVtC4i1/ilft5IJDmzsVFKSF8I5jcGNAzI9 pB4mgrAqeFmt5XHvDqji =C9mX -----END PGP SIGNATURE----- --==-=-=--