elfeed-prune/elfeed-prune.el

;;; elfeed-prune.el --- Elfeed database pruning -*- lexical-binding: t; -*-

;; Copyright (C) 2024 Bram Schoenmakers

;; Author: Bram Schoenmakers <me@bramschoenmakers.nl>
;; Maintainer: Bram Schoenmakers <me@bramschoenmakers.nl>
;; Created: 1 July 2024
;; Package-Version: 0.1
;; Package-Requires: ((emacs "29.1"))
;; Keywords:
;; URL:

;; This file is not part of GNU Emacs.

;; MIT License

;; Copyright (c) 2024 Bram Schoenmakers

;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

;;; Commentary:

;;; Code:

(require 'elfeed)

(defcustom elfeed-prune-enabled nil
  "Set to t to perform actual pruning on the database.

This boolean serves as a safety pin, because the elfeed database
was not designed to have items removed. By setting this boolean
to t you are aware of the risks."
  :group 'elfeed-prune
  :type 'boolean)

(defcustom elfeed-prune-days-read 90
  "Read items older than this amount of days will be pruned."
  :group 'elfeed-prune
  :type 'natnum)

(defcustom elfeed-prune-days-unread 30
  "Unread items older than this amount of days will be pruned."
  :group 'elfeed-prune
  :type 'natnum)

(defcustom elfeed-prune-gc t
  "Run `elfeed-db-gc' to remove stale content from disk."
  :group 'elfeed-prune
  :type 'boolean)

(defcustom elfeed-prune-predicates
  (list #'elfeed-prune--entry-too-old-p
        #'elfeed-prune--feed-unlisted-p)
  "Entries that match *any* of these predicates are pruned.

Each predicate accepts an entry and a feed object and should
return t when the entry should be pruned, unless any of the
predicates in `elfeed-prune-keep-predicates' returns t."
  :group 'elfeed-prune
  :type '(repeat function))

(defcustom elfeed-prune-keep-predicates nil
  "Always keep entries that match one of these predicates.

Each predicate accepts an entry and a feed object and should
return t when the entry should be kept."
  :group 'elfeed-prune
  :type '(repeat function))

(defun elfeed-prune--feed-unlisted-p (entry feed)
  (not (seq-contains-p (mapcar #'car elfeed-feeds)
                       (elfeed-feed-url feed)
                       #'string=)))

(defun elfeed-prune--entry-too-old-p (entry _)
  "Return t if the given ENTRY is considered too old.

The thresholds are configured through the variables
`elfeed-prune-days-read' and `elfeed-prune-days-unread'."
  (let* ((current-time (float-time))
         (entry-time (elfeed-entry-date entry))
         (unread-p (seq-contains-p (elfeed-entry-tags entry) 'unread))
         (threshold-days (if unread-p
                             elfeed-prune-days-unread
                           elfeed-prune-days-read))
         (threshold-seconds (* 60 60 24 threshold-days))
         (entry-age (- current-time entry-time)))
    (> entry-age threshold-seconds)))

(defun elfeed-prune (&optional dry-run)
  "Prune the database entries.

Entries for which `elfeed-prune--elfeed-prune-entry-p' returns t are
removed from the database.

When DRY-RUN in non-nil, no actual pruning will be done, but the
number of items that would be removed will be shown in the echo
area."
  (interactive "P")
  (elfeed-db-ensure)
  (let ((total-entries (hash-table-count elfeed-db-entries))
        (removed-entries 0)
        ;; Make a copy so we don't iterate over a changing data structure
        ;; Also useful to gather stats in a dry run.
        (elfeed-db-index-copy (avl-tree-copy elfeed-db-index))
        (elfeed-db-entries-copy (copy-hash-table elfeed-db-entries)))
    ;; Remove entries
    (with-elfeed-db-visit (entry feed)
      (let ((prune-p (seq-some
                      (lambda (f) (funcall f entry feed))
                      elfeed-prune-predicates))
            (keep-p (seq-some
                     (lambda (f) (funcall f entry feed))
                     elfeed-prune-keep-predicates)))
        (when (and prune-p (not keep-p))
          ;; The `with-elfeed-db-visit' declares the variable `id' that
          ;; contains the entry ID.
          (setq removed-entries (1+ removed-entries))
          (avl-tree-delete elfeed-db-index-copy id)
          (remhash id elfeed-db-entries-copy))))
    (when (and
           elfeed-prune-enabled
           (not dry-run)
           (< 0 removed-entries))
      (setf (plist-get elfeed-db :index) elfeed-db-index-copy)
      (setf elfeed-db-index (plist-get elfeed-db :index))
      (setf (plist-get elfeed-db :entries) elfeed-db-entries-copy)
      (setf elfeed-db-entries (plist-get elfeed-db :entries))
      (elfeed-db-set-update-time)
      (elfeed-db-save-safe)
      (when elfeed-prune-gc
        (elfeed-db-gc-safe)))
    (if (or dry-run (not elfeed-prune-enabled))
        (message "Would remove %d/%d elfeed entries [dry run]"
                 removed-entries
                 total-entries)
      (message "Removed %d/%d elfeed entries"
               removed-entries
               total-entries))))

(provide 'elfeed-prune)
;;; elfeed-prune.el ends here