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