;;; my-packages-extra.el --- Provides additional functions related to
;;; packages

;;; Commentary:

;;; Code:

(require 'package)

;; Original idea: https://www.manueluberti.eu/emacs/2021/09/01/package-report/
(defun my/package-report ()
  "Report total package counts grouped by archive."
  (interactive)
  (package-refresh-contents)
  (my/display-package-report
   (let* ((arch-pkgs (my/archive-packages))
          (counts (seq-sort-by #'cdr #'> (my/archive-counts arch-pkgs)))
          (by-arch (seq-group-by #'car arch-pkgs)))
     (concat
      (format "Total packages: %s\n\n" (apply #'+ (mapcar #'cdr counts)))
      (mapconcat
       (lambda (archive)
         (concat "• "
                 (format "%s (%s)" (car archive) (cdr archive))
                 ": "
                 (mapconcat (lambda (ap-pair) (cdr ap-pair))
                            (alist-get (car archive) by-arch)
                            ", ")))
       counts
       "\n\n")))))

(defun my/display-package-report (output)
  "Display OUTPUT in a popup buffer."
  (let ((buffer-name "*package-report*"))
    (with-help-window buffer-name
      (with-current-buffer buffer-name
        (visual-line-mode 1)
        (erase-buffer)
        (insert output)
        (goto-char (point-min))))))

(defun my/archive-packages ()
  "Return a list of (archive . package) cons cells."
  (seq-reduce
   (lambda (res package)
     (let ((archive (package-desc-archive
                     (cadr (assq package package-archive-contents))))
           (pkg (symbol-name package)))
       (push (cons archive pkg) res)))
   (mapcar #'car package-alist)
   nil))

(defun my/archive-counts (arch-pkgs)
  "Return a list of cons cells from alist ARCH-PKGS.
The cars are package archives, the cdrs are the number of
packages installed from each archive."
  (seq-reduce
   (lambda (counts key)
     (cons (cons key (+ 1 (or (cdr (assoc key counts)) 0)))
           (assoc-delete-all key counts)))
   (mapcar #'car arch-pkgs)
   nil))

(provide 'my-packages-extra)
;;; my-packages-extra.el ends here