Rework & polish doom-store library

+ Add doom-store-rem
+ Add real doom-store-member-p (to replace doom-store-exists alias)
+ Fix doom-store-clear not clearing in-memory store
+ Add doom-store-flush
+ Add deferred flushing through doom--inhibit-flush lexical var
+ Update doom-store-persist & doom-store-desist for new API
This commit is contained in:
Henrik Lissner 2020-05-02 19:26:34 -04:00
parent 5a54ef1f9f
commit 4b28e9ce86
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -3,7 +3,7 @@
;; This little library abstracts the process of writing arbitrary elisp values
;; to a 2-tiered file store (in `doom-store-dir'/`doom-store-location').
(defvar doom-store-dir (concat doom-cache-dir "store/")
(defvar doom-store-dir (concat doom-etc-dir "store/")
"Directory to look for and store data accessed through this API.")
(defvar doom-store-persist-alist '(t)
@ -16,15 +16,19 @@ name under `pcache-directory' (by default a subdirectory under
`doom-store-dir'). One file may contain multiple cache entries.")
(defvar doom--store-table (make-hash-table :test 'equal))
(defvar doom--inhibit-flush nil)
(defun doom-save-persistent-store-h ()
"Hook to run when an Emacs session is killed. Saves all persisted variables
listed in `doom-store-persist-alist' to files."
(let (locations)
(let ((doom--inhibit-flush t))
(dolist (alist (butlast doom-store-persist-alist 1))
(cl-loop with key = (car alist)
(cl-loop with location = (car alist)
for var in (cdr alist)
if (symbol-value var)
do (doom-store-put var it nil key))))
do (doom-store-put var (symbol-value var) nil location)
and do (cl-pushnew location locations))))
(mapc #'doom--store-flush locations)))
(add-hook 'kill-emacs-hook #'doom-save-persistent-store-h)
@ -34,84 +38,105 @@ listed in `doom-store-persist-alist' to files."
;;;###autoload
(defun doom-store-persist (location variables)
"Persist VARIABLES (list of symbols) in LOCATION (symbol).
This populates these variables with cached values, if one exists, and saves them
to file when Emacs quits.
Warning: this is incompatible with buffer-local variables."
to file when Emacs quits. This cannot persist buffer-local variables."
(dolist (var variables)
(when (doom-store-exists var location)
(when (doom-store-member-p var location)
(set var (doom-store-get var location))))
(setf (alist-get location doom-store-persist-alist)
(append variables (cdr (assq location doom-store-persist-alist)))))
(append variables (alist-get location doom-store-persist-alist))))
;;;###autoload
(defun doom-store-desist (location &optional variables)
"Unregisters VARIABLES (list of symbols) in LOCATION (symbol) from
`doom-store-persist-alist', thus preventing them from being saved between sessions.
Does not affect the actual variables themselves or their values."
"Unregisters VARIABLES (list of symbols) in LOCATION (symbol).
Variables to persist are recorded in `doom-store-persist-alist'. Does not affect
the actual variables themselves or their values."
(if variables
(setf (alist-get location doom-store-persist-alist)
(cl-set-difference (cdr (assq location doom-store-persist-alist))
variables))
(delq (assq location doom-store-persist-alist)
doom-store-persist-alist)))
(delq! location doom-store-persist-alist 'assoc)))
(defun doom--store-init (location)
(or (gethash location doom--store-table)
(if (file-exists-p doom-store-dir)
(let* ((store (expand-file-name location doom-store-dir))
(data (and (file-exists-p store)
(let* ((file-name-handler-alist nil)
(location-path (expand-file-name location doom-store-dir)))
(if (file-exists-p location-path)
(puthash location
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary)
(let (file-name-handler-alist)
(insert-file-contents-literally store))
(read (current-buffer))))))
(puthash location data doom--store-table)
data)
(make-hash-table :test #'equal))))
(insert-file-contents-literally location-path)
(read (current-buffer)))
doom--store-table)
(puthash location (make-hash-table :test 'equal)
doom--store-table)))))
(defun doom--store-get (key location &optional default-value)
(if-let* ((location-data (doom--store-init location))
(data (gethash location location-data))
(_ (or (null (car data))
(not (time-less-p (car data) (current-time))))))
(let* ((location-data (doom--store-init location))
(data (gethash key location-data default-value)))
(if (and (not (eq data default-value))
(or (null (car data))
(not (time-less-p (car data) (current-time)))))
(cdr data)
default-value))
default-value)))
(defun doom--store-put (key value location &optional ttl)
(let ((data (doom--store-init location)))
(puthash location (cons (if ttl (time-add (current-time) ttl)) value) data)
(let ((coding-system-for-write 'binary)
(puthash key (cons (if ttl (time-add (current-time) ttl)) value)
(doom--store-init location))
(doom--store-flush location))
(defun doom--store-flush (location)
(unless doom--inhibit-flush
(let ((file-name-handler-alist nil)
(coding-system-for-write 'binary)
(write-region-annotate-functions nil)
(write-region-post-annotation-function nil))
(write-region-post-annotation-function nil)
(data (doom--store-init location)))
(make-directory doom-store-dir 'parents)
(with-temp-file (expand-file-name location doom-store-dir)
(prin1 data (current-buffer))))
data))
(prin1 data (current-buffer)))
data)))
;;;###autoload
(defun doom-store-get (key &optional location default-value)
"Retrieve KEY from LOCATION (defaults to `doom-store-location'), if it exists
and hasn't expired."
"Retrieve KEY from LOCATION (defaults to `doom-store-location').
If it doesn't exist or has expired, DEFAULT_VALUE is returned."
(doom--store-get key (or location doom-store-location) default-value))
;;;###autoload
(defun doom-store-put (key value &optional ttl location)
"Set KEY to VALUE in the cache. TTL is the time (in seconds) until this cache
entry expires. LOCATION is the super-key to store this cache item under; the
default is `doom-store-location'. "
"Set KEY to VALUE in the store at LOCATION.
KEY can be any lisp object that is comparable with `equal'. TTL is the time (in
seconds) until this cache entry expires. LOCATION is the super-key to store this
cache item under. It defaults to `doom-store-location'."
(doom--store-put key value (or location doom-store-location) ttl))
;;;###autoload
(defalias 'doom-store-exists #'doom-store-get)
(defun doom-store-rem (key &optional location)
"Clear a cache LOCATION (defaults to `doom-store-location')."
(let ((location (or location doom-store-location)))
(remhash key (doom--store-init location))
(let ((table (doom--store-init "default")))
(remhash 'test table)
table)
(doom--store-flush location)))
;;;###autoload
(defun doom-store-member-p (key &optional location)
"Return t if KEY in LOCATION exists.
LOCATION defaults to `doom-store-location'."
(let ((nil-value (format "--nilvalue%s--" (current-time))))
(not (equal (doom-store-get key location nil-value)
nil-value))))
;;;###autoload
(defun doom-store-clear (&optional location)
"Clear a cache LOCATION (defaults to `doom-store-location')."
(let ((path (expand-file-name (or location doom-store-location) doom-store-location)))
"Clear the store at LOCATION (defaults to `doom-store-location')."
(let* ((location (or location doom-store-location))
(path (expand-file-name location doom-store-dir)))
(remhash location doom--store-table)
(when (file-exists-p path)
(delete-file path)
t)))