[elpa] externals/repology cfcf12bddc 1/5: repology: Add finer control over outdated package definition

[Nicolas Goaziou]

branch: externals/repology
commit cfcf12bddcaf794f905f95f4e3a62ee62031675a
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Commit: Nicolas Goaziou <mail@nicolasgoaziou.fr>

    repology: Add finer control over outdated package definition
    
    * repology.el (repology-outdated-project-definition): New variable.
    * repology-utils.el (repology-filter-outdated-projects):
    (repology--masked-package-p): New functions.
---
 repology-utils.el | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 repology.el       | 73 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 163 insertions(+)

diff --git a/repology-utils.el b/repology-utils.el
index d4f5fd0264..99c911decc 100644
--- a/repology-utils.el
+++ b/repology-utils.el
@@ -147,6 +147,64 @@ Return \"-\" if PACKAGE has no version field."
         (propertize version 'face (repology--package-status-face package))
       "-")))
 
+(defun repology-filter-outdated-projects (projects repository)
+  "Filter outdated projects from PROJECTS list.
+
+PROJECTS is a list of Repology projects.  REPOSITORY is the name
+of the reference repository, as a string.
+
+Outdated projects are defined according to the value of the
+variable `repology-outdated-project-definiton', which see.
+
+Return a list of Repology projects."
+  (seq-filter
+   (lambda (project)
+     (let ((reference-package
+            (seq-find (lambda (p)
+                        (equal repository (repology-package-field p 'repo)))
+                      (repology-project-packages project))))
+       (cond
+        ((not reference-package)
+         (user-error "No package for project %S in repository %S"
+                     project repository))
+        ;; Default definition for outdated projects: trust Repology's
+        ;; status from reference package.
+        ((not repology-outdated-project-definition)
+         (equal "outdated" (repology-package-field reference-package 'status)))
+        (t
+         ;; Custom definition: compare versions of non-masked outdated
+         ;; or newest packages.
+         (let ((version (repology-package-field reference-package 'version))
+               ;; Ignore masks not applicable to the current project.
+               (masks
+                (seq-filter (let ((name (repology-project-name project)))
+                              (pcase-lambda (`(,name-re ,_ ,_))
+                                (or (not name-re)
+                                    (string-match name-re name))))
+                            repology-outdated-project-definition))
+               ;; Cache limiting the number of versions comparison.
+               (older nil))
+           (seq-some
+            (lambda (package)
+              (pcase (repology-package-field package 'status)
+                ;; Ignore reference package.
+                ((guard (equal package reference-package)) nil)
+                ;; Ignore packages with a dubious status.
+                ((or "devel" "ignored" "incorrect" "legacy" "noscheme" 
"rolling"
+                     "untrusted")
+                 nil)
+                ;; Ignore masked packages.
+                ((guard (repology--masked-package-p package masks))
+                 nil)
+                ;; Otherwise, compare versions.
+                (_
+                 (let ((v (repology-package-field package 'version)))
+                   (and (not (member v older))
+                        (prog1 (repology-version-< version v)
+                          (push v older)))))))
+            (repology-project-packages project)))))))
+   projects))
+
 
 ;;; Projects
 (defun repology-project-p (object)
@@ -203,6 +261,38 @@ Versions are sorted in descending order."
           ;; Return versions in decreasing order.
           (lambda (s1 s2) (repology-version-< s2 s1)))))
 
+(defun repology--masked-package-p (package masks)
+  "Return non-nil if PACKAGE is masked.
+PACKAGE is a Repology package. MASKS is a list of
+masks, as defined in `repology-outdated-project-definition'."
+  (seq-some
+   (pcase-lambda (`(,_ ,version ,repository-re))
+     (and (or (not version)
+              (progn
+                (unless (string-match
+                         (rx string-start
+                             (or "<=" "<" "=" ">" ">=")
+                             (zero-or-more space))
+                         version)
+                  (user-error "Invalid version comparison string: %S"
+                              version))
+                (let ((prefix (match-string 0 version))
+                      (base (substring version (match-end 0)))
+                      (package-version
+                       (repology-package-field package 'version)))
+                  (pcase prefix
+                    ("=" (and
+                          (not (repology-version-< base package-version))
+                          (not (repology-version-< package-version base))))
+                    ("<=" (not (repology-version-< base package-version)))
+                    (">=" (not (repology-version-< package-version base)))
+                    ("<" (repology-version-< package-version base))
+                    (">" (repology-version-< base package-version))))))
+          (or (not repository-re)
+              (string-match-p repository-re
+                              (repology-package-field package 'repo)))))
+   masks))
+
 
 ;;; Problems
 (defun repology-problem-field (problem field)
diff --git a/repology.el b/repology.el
index 7baa7f8147..36f8b89c6b 100644
--- a/repology.el
+++ b/repology.el
@@ -65,6 +65,30 @@
 ;;                 (repology-search-projects
 ;;                  :search "emacs" :inrepo "gnuguix" :outdated "on")))
 
+;; By default, the package trusts Repology's status values to report
+;; outdated packages.  However, this can introduce false positives.
+;; You can then set `repology-outdated-project-definition' accordingly
+;; to ignore those.
+
+;; For example, with the following set-up, I can look for every
+;; outdated Emacs packages and Asymptote package in GNU Guix, ignoring
+;; bogus versions for "emacs:circe", and "emacs:erlang" package
+;; altogether.  I also sort projects alphabetically.
+
+;; (setq repology-outdated-project-definition
+;;       '(("emacs:circe" "<=2.11" nil)
+;;         ("emacs:erlang" nil nil))
+;;       repology-display-projects-sort-key '("Project" . nil))
+;;
+;;    (let ((repo "gnuguix"))
+;;      (repology-display-projects
+;;       (repology-filter-outdated-projects
+;;           (append (repology-search-projects :search "emacs:" :outdated "on"
+;;                                             :inrepo repo)
+;;                   '("asymptote"))
+;;           repo)
+;;       repo))
+
 ;; Eventually, this library provides an interactive function with
 ;; a spartan interface wrapping this up: `repology'.  Since it builds
 ;; and displays incrementally search filters, you may use it as
@@ -138,6 +162,55 @@ See `repology-check-freedom' for more information."
           (const :tag "Free and unknown projects" include-unknown)
           (const :tag "Every project" nil)))
 
+(defcustom repology-outdated-project-definition nil
+  "Determine how projects are considered as \"outdated\".
+
+This function affects `repology-filter-outdated-projects' function.
+
+When nil, a project is considered as \"outdated\" relatively to
+a repository whenever the corresponding package from that
+repository has the \"outdated\" status.
+
+Otherwise, it can be set to a list of masks.  A mask is a triplet
+
+  (NAME VERSION REPOSITORY)
+
+where NAME is a regexp or nil, VERSION is a string prefixed with
+either \"<\", \"<=\", \"=\", \">\" or \">=\", and REPOSITORY is
+a regexp or nil.
+
+Project's packages are matched against every non-nil criteria in
+the mask.  For example, the mask
+
+  (\"^Foo$\" \"=2\" nil)
+
+matches against project Foo at version 2 (or 2.0.0) only, in any
+repository.
+
+The mask
+
+  (nil nil \"BSD\")
+
+matches against any project from *BSD repositories.
+
+In this case, a project is \"outdated\" when the version of the
+package from the reference repository is older than the version
+of any non-masked package."
+  :type
+  '(choice
+    (const :tag "Use Repology packages status" nil)
+    (repeat :tag "Compare version with unmasked packages"
+     (list :tag "Mask"
+           (choice
+            (regexp :tag "Regexp matching project name")
+            (const :tag "Any project" nil))
+           (choice
+            (string :tag "Version comparison string")
+            (const :tag "Any version" nil))
+           (choice
+            (regexp :tag "Regexp matching repository name")
+            (const :tag "Any repository" nil))))))
+
 (defcustom repology-display-problems-columns
   `(("Project" effname 20 t)
     ("Package name" visiblename 20 t)