branch: elpa/haskell-tng-mode
commit 48729c8790ac0287d0cbba577e9d979d21c91abc
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
more cache cleanups
---
README.md | 2 +
haskell-tng-extra-company.el | 1 +
haskell-tng-hsinspect.el | 12 ++---
haskell-tng-util.el | 120 +++++++++++++++++++++++++------------------
4 files changed, 78 insertions(+), 57 deletions(-)
diff --git a/README.md b/README.md
index 1eb1129..cb12920 100644
--- a/README.md
+++ b/README.md
@@ -86,6 +86,8 @@ To automatically import a symbol at point, use `M-x
haskell-tng-import-symbol-at
+All `hsinspect` commands are heavily cached and never invalidated to maximise
availability. If the caches are out of date and no longer useful, run the
command again prefixed with `C-u` to force a fresh invocaton of hsinpsect.
+
## Extras
Integrations are provided for common libraries and external applications.
diff --git a/haskell-tng-extra-company.el b/haskell-tng-extra-company.el
index f9f713f..50efbde 100644
--- a/haskell-tng-extra-company.el
+++ b/haskell-tng-extra-company.el
@@ -54,6 +54,7 @@
;;(message "TNG asked with %S" arg)
(seq-mapcat
(lambda (names) (all-completions arg (seq-map #'cdr names)))
+ ;; TODO do the imports query on a timer when idle (only once per buffer)
(haskell-tng--hsinspect-imports 'no-work)))
('sorted t)
('duplicates t)
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 94b3e16..4b72c99 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -119,22 +119,18 @@ A prefix argument ensures that caches are flushes."
(defvar-local haskell-tng--hsinspect-imports nil)
(defun haskell-tng--hsinspect-imports (&optional no-work flush-cache)
(haskell-tng--hsinspect-cached
- #'haskell-tng--hsinspect
- `("imports" ,buffer-file-name)
+ (lambda () (haskell-tng--hsinspect "imports" buffer-file-name))
'haskell-tng--hsinspect-imports
(concat "hsinspect-0.0.7" buffer-file-name "." "imports")
no-work
flush-cache))
-;; TODO use a package specific variable buffer to save memory
-(defvar-local haskell-tng--hsinspect-index nil)
+;; TODO use a package specific variable buffer
(defun haskell-tng--hsinspect-index (&optional flush-cache)
(when-let (ghcflags-dir
(locate-dominating-file default-directory ".ghc.flags"))
- (haskell-tng--hsinspect-cached
- #'haskell-tng--hsinspect
- '("index")
- 'haskell-tng--hsinspect-index
+ (haskell-tng--hsinspect-cached-disk
+ (lambda () (haskell-tng--hsinspect "index"))
(concat "hsinspect-0.0.7" (expand-file-name ghcflags-dir) "index")
nil
flush-cache)))
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 25733cc..a4472dd 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -95,61 +95,83 @@ and taking a regexp."
(concat "qualified " module " as " as)))
"\n")))
-;; TODO split into two calls: disk and local
;; TODO needs a unit test
-;; TODO a macro that expands out the local variable
(defun haskell-tng--hsinspect-cached
- (fn args local disk &optional no-work flush-cache)
- "A two-tier cache over a FN that takes ARGS.
+ (work sym key &optional no-work reset)
+ "A two-tier (variable and disk-based) cache over WORK.
+
The caller is responsible for flushing the cache. For
consistency, it is recommended that commands using this cache
-flush the cache when the universal argument is provided.
-
-If the LOCAL reference contains a cache of a previous call, it is
+flush the cache when the universal argument is provided."
+ (haskell-tng--hsinspect-cached-variable
+ (lambda ()
+ (haskell-tng--hsinspect-cached-disk
+ work
+ key
+ no-work
+ reset))
+ sym
+ nil
+ reset))
+
+(defun haskell-tng--hsinspect-cached-variable (work sym &optional no-work
reset)
+ "A variable cache over a function WORK.
+
+If the SYM reference contains a cache of a previous call, it is
returned immediately.
-If DISK expands to a file that exists in the cache directory, it
-is read as an s-expression, saved to LOCAL, and returned. Callers
-are advised to version their DISK cache as it is persisted
-between restarts and software upgrades.
-
-Otherwise FN is called with ARGS and saved to both LOCAL and
-DISK.
-
-Errors are not cached, nil return values are cached in LOCAL but
-not in DISK.
-
-NO-WORK skips FN and only queries the caches.
-
-FLUSH-CACHE forces both LOCAL and DISK to be invalidated."
- (when flush-cache
- (set local nil))
- (when (not (symbol-value local))
- (let ((cache-file-name
- (concat (xdg-cache-home) "/haskell-tng/" disk ".gz")))
- (when (and flush-cache (file-exists-p cache-file-name))
- (delete-file cache-file-name))
- (if (file-exists-p cache-file-name)
- (set
- local
- (with-temp-buffer
- ;; TODO set jka-compr-verbose to nil to disable messages
(currently
- ;; giving useful debugging hints so left on).
- (insert-file-contents cache-file-name)
- (goto-char (point-min))
- (ignore-errors (read (current-buffer)))))
- (unless (or no-work
- (eq 'cached-nil (symbol-value local)))
- (set local 'cached-nil)
- (set local (apply fn args))
- (if-let (cache (symbol-value local))
- (with-temp-file cache-file-name
- (make-directory (file-name-directory cache-file-name)
'create-parents)
- (prin1 cache (current-buffer)))
- (set local 'cached-nil))))))
-
- (when (not (eq 'cached-nil (symbol-value local)))
- (symbol-value local)))
+Otherwise WORK is called with no parameters and saved to SYM.
+
+Errors are NOT cached.
+
+nil return values are cached.
+
+NO-WORK skips WORK and only queries the cache.
+
+RESET sets the variable to nil before doing anything."
+ (when reset
+ (set sym nil))
+ (when (not (symbol-value sym))
+ (unless no-work
+ (set sym (funcall work))
+ (unless (symbol-value sym)
+ (set sym 'cached-nil))))
+ (pcase (symbol-value sym)
+ ('cached-nil nil)
+ (cached cached)))
+
+(defun haskell-tng--hsinspect-cached-disk (work key &optional no-work reset)
+ "A disk-based cache over a function WORK.
+
+If the cache contains a file matching the KEY string (which must
+be filesystem safe), it is parsed as an s-expressed and returned.
+
+Otherwise WORK is called with no parameters and saved to the KEY.
+
+Errors are NOT cached.
+
+nil return values are NOT cached.
+
+NO-WORK skips WORK and only queries the cache.
+
+RESET deletes the cache if it exists."
+ (let ((cache-file
+ (concat (xdg-cache-home) "/haskell-tng/" key ".gz")))
+ (when (and reset (file-exists-p cache-file))
+ (delete-file cache-file))
+ (if (file-exists-p cache-file)
+ (with-temp-buffer
+ ;; TODO set jka-compr-verbose to nil to disable messages (currently
+ ;; giving useful debugging hints so left on).
+ (insert-file-contents cache-file)
+ (goto-char (point-min))
+ (ignore-errors (read (current-buffer))))
+ (unless no-work
+ (when-let (result (funcall work))
+ (with-temp-file cache-file
+ (make-directory (file-name-directory cache-file) 'create-parents)
+ (prin1 result (current-buffer)))
+ result)))))
(provide 'haskell-tng-util)
;;; haskell-tng-util.el ends here
