(use-modules (guix inferior)
             (srfi srfi-1)
             (srfi srfi-19)
             (ice-9 match)
             (ice-9 format)
             (guix store)
             (guix progress))

(define %timings (make-hash-table))

;; (define (package->derivation* package system . args)
;;   (lambda (store)
;;     (values (let ((start (current-time))
;;                   (drv   (apply package-derivation store
;;                                 package system args))
;;                   (stop  (current-time)))
;;               (hashq-set! %timings package
;;                           (time-difference stop start))
;;               drv)
;;             store)))

(define %inferior-directory
  (string-append (getenv "HOME") "/.config/guix/current"))

(define (all-packages)
  (let* ((inferior (open-inferior %inferior-directory))
         (packages (inferior-available-packages inferior)))
    (close-inferior inferior)
    packages))

(define (time-package-derivation name version)
  (with-store store
    (let* ((inferior (open-inferior %inferior-directory))
           (_        (inferior-eval '(begin
                                       (use-modules (guix grafts))
                                       (%graft? #f))
                                    inferior))
           (package  (car (lookup-inferior-packages inferior name version)))
           (start    (current-time))
           (drv      (inferior-package-derivation store package))
           (stop     (current-time)))
      (close-inferior inferior)
      (hash-set! %timings (cons name version)
                 (time-difference stop start)))))

(define* (display-timings #:optional (port (current-output-port)))
  (define alist
    (hash-map->list cons %timings))

  (for-each (match-lambda
              ((package . duration)
               (format port "~5,2f ~s~%"
                       (+ (time-second duration)
                          (/ (time-nanosecond duration) 1e9))
                       package)))
            (sort alist (match-lambda*
                          (((_ . d1) (_ . d2))
                           (time>? d1 d2))))))

(define (run-benchmark)
  (let ((packages (all-packages)))
    (call-with-progress-reporter (progress-reporter/bar (length packages))
      (lambda (report)
        (for-each (match-lambda
                    ((name . version)
                     (time-package-derivation name version)
                     (report)))
                  packages)
        (display-timings)))))

(sigaction SIGINT (lambda (_) (display-timings)))
(run-benchmark)