Re: Add a function for building sort predicates

[Daniel Mendler]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Hello,
>
> I looked at how "package.el" defines the sort predicates for the used
> tabulated list view - for example, `package-menu--status-predicate':
>
> #+begin_src emacs-lisp
> (defun package-menu--status-predicate (A B)
>   "Predicate to sort \"*Packages*\" buffer by the status column.
> This is used for `tabulated-list-format' in `package-menu-mode'."
>   (let ((sA (aref (cadr A) 2))
>         (sB (aref (cadr B) 2)))
>     (cond ((string= sA sB)
>            (package-menu--name-predicate A B))
>           ((string= sA "new") t)
>           ((string= sB "new") nil)
>           ((string-prefix-p "avail" sA)
>            (if (string-prefix-p "avail" sB)
>                (package-menu--name-predicate A B)
>              t))
>           ((string-prefix-p "avail" sB) nil)
>           ((string= sA "installed") t)
>           ((string= sB "installed") nil)
>           ((string= sA "dependency") t)
>           ((string= sB "dependency") nil)
>           ((string= sA "source") t)
>           ((string= sB "source") nil)
>           ((string= sA "unsigned") t)
>           ...
>           (t (string< sA sB)))))
> #+end_src
>
>
> This is hard to read and maintain, 0% user configurable, and it's not
> easy to add additional "layers", like, "sort packages with equal states
> first by archive name, and only then by name".
>
> I want to suggest to add a function for defining sort predicates for
> cases like these (especially having tabulated-list-mode in mind, but not
> only - sorting is a common task).
>
> Here is what I would imagine:
>
> #+begin_src emacs-lisp
> ;; -*- lexical-binding: t -*-
>
> (defun make-sort-pred (rules)
>   "Return a sort predicate according to the sort RULES.
> The returned predicate will accept two arguments A and B.  When
> called, it will try RULES in order to decide whether A < B and
> return non-nil in that case and nil when B <= A.  When no rule can
> decide whether A < B, the predicate will also return nil.
>
> RULES is a list of sort specifications using one of the formats
> explained below.
>
> The allowed formats of the specification lists in RULES are:
>
>  -- (KEYFUN PRED)
>
> This is like
>
>        (lambda (a b)
>          (funcall PRED (funcall KEYFUN a)
>                        (funcall KEYFUN b)))
>
>  -- (KEYFUN EQUAL-TEST . KEYLIST)
>
> This spec allows to specify the order of keys explicitly when the
> number of possible keys is small by specifying an accordingly
> ordered KEYLIST directly.
>
> A test using this rule form will first call KEYFUN with the
> arguments A and B to get K-A and K-B.  Then, using the equality
> test EQUAL-TEST, it is tested to which of the elements in KEYLIST
> K-A and K-B are equal.  It is decided whether A < B using the
> natural order of the KEYLIST elements.  Keys not found in KEYLIST
> are treated it as if coming after all of its elements.  Elements
> for that KEYFUN yields `equal' values are considered
> indistinguishable.
>
>  -- (KEYFUN EQUAL-TEST GET-KEYLIST)
>
> This works exactly like the above spec - the only difference is
> that GET-KEYLIST is either a symbol whose `symbol-value' will be
> consulted, or a function accepting zero arguments to obtain the
> KEYLIST to use, at run-time.  In the latter case the function
> should be accordingly cheap when called and avoid unnecessary
> consing.
>
>
> Example 1: Sort a list like this:
>
>   ((\"c\" 2) (\"a\" 3) (\"b\" 1) (\"b\" 3) (\"c\" 3)
>    (\"c\" 1) (\"a\" 2) (\"b\" 2))
>
> first by the first element, then by the second:
>
> (sort \\='((\"c\" 2) (\"a\" 3) (\"b\" 1) (\"b\" 3) (\"c\" 3)
>         (\"c\" 1) (\"a\" 2) (\"b\" 2))
>       (make-sort-pred `((,#'car  ,#'string<)
>                         (,#'cadr ,#'<))))
>
> Example 2: Create a sort predicate suitable for sorting the list
> of packages for M-x list-packages.  We want to have all \"new\"
> packages listed first, then all obsolete packages, according to
> the following list:
>
>   (defvar my-package-menu--status-sorting-order
>    \\='(\"new\" \"obsolete\" \"held\" \"external\" ...))
>
> Package in the same category should be sorted by archive in a certain
> order, and last by name:
>
> (defalias \\='my-package-menu--status-predicate
>   (make-sort-pred
>    `((,(lambda (x) (aref (cadr x) 2))
>       ,#'string= my-package-menu--status-sorting-order)
>      (,(lambda (x) (package-desc-archive (car x)))
>       ,#'equal \"gnu\" \"nongnu\" \"melpa\" nil)
>      (,#'identity ,#'package-menu--name-predicate))))"
>
>   (let ((result (make-symbol "result")))
>     (cl-flet ((compare-with (test a b)
>                 (cond
>                  ((funcall test a b) (throw result t))
>                  ((funcall test b a) (throw result nil)))))
>       (let ((rules
>              ;; translate RULES to test functions
>              (mapcar
>               (pcase-lambda (`(,keyfun . ,rule))
>                 (if (cdr rule)
>                     (let* ((test (car rule))
>                            (testfun (lambda (x y)
>                                       (funcall test y (funcall keyfun x))))
>                            (keys (cdr rule))
>                            (ckeys (car keys)))
>                       (cl-flet ((keys (cond ((cdr keys) (lambda () keys))
>                                             ((symbolp ckeys)
>                                              (lambda () (symbol-value ckeys)))
>                                             (t (lambda () (funcall ckeys))))))
>                         (lambda (a b)
>                           (cl-block nil
>                             (let ((keys (keys)))
>                               (while keys
>                                 (let ((key (pop keys)))
>                                   (cond ((funcall testfun a key)
>                                          (if (funcall testfun b key)
>                                              (cl-return)
>                                            (throw result t)))
>                                         ((funcall testfun b key)
>                                          (throw result nil))))))))))
>                   (lambda (a b)
>                     (compare-with
>                      (car rule)
>                      (funcall keyfun a) (funcall keyfun b)))))
>                      rules)))
>
>         (lambda (a b)
>           (catch result
>             ;; any rule throws 'result' when a<b is decidable with it
>             (dolist (rule rules) (funcall rule a b))
>             ;; no rule was able to decide - return nil for stable sorting
>             nil))))))
> #+end_src
>
> Running time is comparable witho the existing code.
>
> Would we want to add something like this?  And to which library?  I
> would like to prepare a patch.

That's a useful addition. Did you consider creating a macro, which will
lead to a more efficient predicate, or is `make-sort-pred' intended to
be used in scenarios with customizable predicate rules, such that the
rules have to be processed at runtime?

Daniel