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

[Nikita Karetnikov <nikita@karetnikov.org>]

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

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’t be found.

Do you see any problems?  Please check everything (especially the
‘first-month’ and ‘last-month’ functions).


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

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


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