org-fc-cache.el

;;; org-fc-cache.el --- Cache for org-fc -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2024  Leon Rische

;; Author: Leon Rische <emacs@leonrische.me>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Even with the AWK based indexer, indexing cards before each review
;; gets slow if there are a lot of files / cards.
;;
;; After running the indexer one time, file checksums are used to
;; determine which cache entries need to be updated, assuming only a
;; small subset of the flashcard files is changed between reviews,
;; this is much faster than building the full index each time.

;;; Code:

(require 'parse-time)

(require 'org-fc-core)
(require 'org-fc-awk)
(require 'org-fc-review)
(require 'org-fc-review-data)

;;; Queue / Processing of Files

(defvar org-fc-cache
  (make-hash-table :test #'equal)
  "Cache mapping filenames to card lists.")

(defun org-fc-cache-build ()
  "Build initial cache."
  (let* ((hashes (org-fc-cache-hashes org-fc-directories))
         (table (make-hash-table :test #'equal)))
    (dolist (entry (org-fc-awk-index org-fc-directories))
      (let* ((path (oref entry path))
             (hash (gethash path hashes)))
        (setf (oref entry hash) hash)
        (puthash path entry table)))
    (setq org-fc-cache table)))

(defun org-fc-cache-update ()
  "Make sure the cache is up to date."
  (let* ((hashes (org-fc-cache-hashes org-fc-directories))
         (changed
          (cl-remove-if
           (lambda (file)
	     (and
	      (gethash file org-fc-cache)
              (string=
               (oref (gethash file org-fc-cache) hash)
               (gethash file hashes))))
           (hash-table-keys hashes))))
    ;; Update changed files
    (dolist (new (org-fc-awk-index changed))
      (let* ((path (oref new path))
             (hash (gethash path hashes)))
	(oset new hash hash)
        (puthash path new org-fc-cache)))
    ;; Remove deleted files
    (dolist (file (hash-table-values org-fc-cache))
      (unless (gethash file hashes)
        (remhash file org-fc-cache)))))

;;; Filtering Entries

(defun org-fc-cache-index (paths &optional filter)
  "Find cards in PATHS matching an optional FILTER.
FILTER is assumed to be a predicate function taking a single card
as its input."
  (org-fc-cache-update)
  ;; Make sure paths are absolute & canonical
  ;; Keys of the hash table can be assumed to be absolute & canonical.
  (setq paths (mapcar #'expand-file-name paths))
  (let (res)
    (maphash
     (lambda (path file)
       (when (cl-some (lambda (p) (string-prefix-p p path)) paths)
	 ;; Use push instead of `nconc' because `nconc' would break
	 ;; the entries of the hash table.
	 ;;
	 ;; To prevent cached files and cards from breaking,
	 ;; we'll also want to clone each one.
	 (let ((cards
		(mapcar #'clone
			(if filter
			    (cl-remove-if-not filter (oref file cards))
			  (oref file cards)))))
	   ;; Only include files that contain some matching cards
	   (when cards
	     (push (clone file :cards cards) res)))))
     org-fc-cache)
    res))

;;; Cache Mode

(defun org-fc-cache--enable ()
  "Enable org-fc-cache.
Initializes the cache and adds hooks."
  (message "building org-fc cache...")
  (org-fc-cache-build)
  (add-hook 'org-fc-before-setup-hook #'org-fc-cache-coherence-check)
  (setq org-fc-index-function #'org-fc-cache-index)
  (message "org-fc cache enabled"))

(defun org-fc-cache--disable ()
  "Disable org-fc-cache.
Resets the cache and removes hooks."
  (setq org-fc-cache (make-hash-table :test #'equal))
  (remove-hook 'org-fc-before-setup-hook #'org-fc-cache-coherence-check)
  (setq org-fc-index-function #'org-fc-awk-index)
  (message "org-fc cache disabled"))

(define-minor-mode org-fc-cache-mode
  "Minor mode for caching org-fc card data.

This mode sets up several hooks to ensure the case updated when files change,
are renamed or deleted."
  :lighter "org-fc cache"
  :group 'org-fc
  :require 'org-fc
  :global t
  (if org-fc-cache-mode
      (org-fc-cache--enable)
    (org-fc-cache--disable)))

;;; Coherence Check

;; TODO: There already is a similar check in org-fc,
;; those should be combined.

;;;###autoload
(defun org-fc-cache-coherence-check ()
  "Check if the entry at point is coherent with its cache
 representation. This is especially relevant w.r.t a card's due
date / suspension state before review."
  (org-fc-review-with-current-item cur
    (when (org-fc-suspended-entry-p)
      (error "Trying to review a suspended card"))
    (let* ((name (oref cur name))
	   (review-data (org-fc-review-data-parse '(due)))
	   (row (org-fc-review-data-get-row review-data name))
	   (due (parse-iso8601-time-string (plist-get row 'due))))
      (unless (time-less-p due (current-time))
	(error "Trying to review a non-due card")))))

;;; Hashing

(defun org-fc-cache-hashes (directories)
  "Compute hashsums of all org files in DIRECTORIES."
  (let ((output (shell-command-to-string
                 (org-fc-awk--pipe
                  (org-fc-awk--find directories)
                  (org-fc-awk--xargs "sha1sum"))))
        (table (make-hash-table :test #'equal)))
    (dolist (line (split-string output "\n" t))
      (let ((parts (split-string line "  ")))
	(unless (string= (cadr parts) "-")
          (puthash (cadr parts) (car parts) table))))
    table))

;;; Footer

(provide 'org-fc-cache)

;;; org-fc-cache.el ends here