;; https://issues.guix.gnu.org/50264

(use-modules (gnu) (guix)
             (guix profiles) (guix monads)
             (ice-9 match) (srfi srfi-1))

(define (all-packages)
  "Return the list of all the packages, public or private, omitting only
superseded packages."
  (fold-packages (lambda (package lst)
                   (match (package-replacement package)
                     (#f (cons package lst))
                     (replacement
                      (append (list replacement package) lst))))
                 '()
                 #:select? (negate package-superseded)))

(define (random-seed)
  (logxor (getpid) (car (gettimeofday))))

(define shuffle                                   ;from offload.scm
  (let ((state (seed->random-state (random-seed))))
    (lambda (lst)
      "Return LST shuffled (using the Fisher-Yates algorithm.)"
      (define vec (list->vector lst))
      (let loop ((result '())
                 (i (vector-length vec)))
        (if (zero? i)
            result
            (let* ((j (random i state))
                   (val (vector-ref vec j)))
              (vector-set! vec j (vector-ref vec (- i 1)))
              (loop (cons val result) (- i 1))))))))

(define (test packages)
  (pk 'testing-packages (map package-full-name packages))
  (let ((manifest (packages->manifest packages)))
    (with-store store
      (let ((drv (run-with-store store
                   (ca-certificate-bundle manifest))))
        (pk 'drv drv)
        (unless (find (lambda (input)
                        (let ((drv (derivation-input-derivation input)))
                          (string-prefix? "glibc-utf8-locales"
                                          (derivation-name drv))))
                      (derivation-inputs drv))
          (pk 'drv drv (derivation-inputs drv))
          (display-backtrace (make-stack #t) (current-error-port))
          (error "bah!" drv))
        (newline) (newline)))))

(let loop ((packages (shuffle (all-packages))))
  (test (take packages 10))
  (loop (drop packages 10)))