Re: New ‘--list-generations’ and ‘--delete-generations’ options

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- Attachment #1.1: Type: text/plain, Size: 1026 bytes --]

> By definition submatches 1 and 2 exist when RES is true.
> Thus, I’d remove ‘safe-match:substring->number’ and 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 ‘cond’, which would be even more
> readable:

>   (cond ((maybe-integer)
>          =>
>          list)
>         ((string-match "^([0-9]+)\\.\\.([0-9]+)$" str)
>          =>
>          (lambda (match)
>            ...))
>         ...)

Are you sure?  I haven’t found a way to make ‘cond’ as readable as ‘or’.

I’m attaching a sketchy version.  If you don’t see any problems, I’ll
try to integrate this code into ‘package.scm’.

(Something is wrong with the store on my machine, so I can’t properly
test the filtering part.  But I’ll do it as soon as possible.)


[-- Attachment #1.2: avail-generations5.scm --]
[-- Type: text/plain, Size: 4232 bytes --]

(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 = ()

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]