[nongnu] elpa/haskell-tng-mode 48729c8 308/385: more cache cleanups

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 48729c8790ac0287d0cbba577e9d979d21c91abc
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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
 
 ![screencast of 
haskell-tng-import-symbol-at-point](screencasts/import-symbol-at-point.gif)
 
+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