[nongnu] elpa/haskell-tng-mode 35d3830 306/385: cache improvements

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 35d383078e53227d3aa550d628abf6c461459219
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    cache improvements
---
 haskell-tng-extra-company.el |  2 +-
 haskell-tng-hsinspect.el     | 43 ++++++++++++++++++-------------------------
 haskell-tng-util.el          | 43 +++++++++++++++++++++----------------------
 3 files changed, 40 insertions(+), 48 deletions(-)

diff --git a/haskell-tng-extra-company.el b/haskell-tng-extra-company.el
index 54304d1..f9f713f 100644
--- a/haskell-tng-extra-company.el
+++ b/haskell-tng-extra-company.el
@@ -54,7 +54,7 @@
      ;;(message "TNG asked with %S" arg)
      (seq-mapcat
       (lambda (names) (all-completions arg (seq-map #'cdr names)))
-      (haskell-tng--hsinspect-imports 'no-work nil)))
+      (haskell-tng--hsinspect-imports 'no-work)))
     ('sorted t)
     ('duplicates t)
     ;; TODO 'meta return the FQN
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index c6b638b..c12ad5d 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -33,16 +33,13 @@ name of the symbol at point in the minibuffer.
 
 A prefix argument ensures that caches are flushes."
   (interactive "P")
-  (if-let* ((sym (haskell-tng--hsinspect-symbol-at-point))
-            (found (seq-find
-                    (lambda (names) (member sym (seq-map #'cdr names)))
-                    (haskell-tng--hsinspect-imports nil alt))))
-      ;; TODO multiple hits
-      ;; TODO feedback when hsinspect is broken
-      (popup-tip (format "%s" (cdar (last found))))
-    (if (eq t haskell-tng--hsinspect-imports)
-        (error "hsinspect is not available")
-      (message "<not imported>"))))
+  (when-let* ((sym (haskell-tng--hsinspect-symbol-at-point))
+              (found (seq-find
+                      (lambda (names) (member sym (seq-map #'cdr names)))
+                      (haskell-tng--hsinspect-imports nil alt))))
+    ;; TODO multiple hits
+    ;; TODO feedback when hsinspect is broken
+    (popup-tip (format "%s" (cdar (last found))))))
 
 ;;;###autoload
 (defun haskell-tng-import-symbol-at-point (&optional alt)
@@ -100,12 +97,12 @@ A prefix argument ensures that caches are flushes."
          (re-search-backward
           (rx symbol-start (+ (| word (syntax symbol) ".")) point)
           (line-beginning-position)
-          t))
+          'no-error))
      (match-beginning 0))
    (save-excursion
      (re-search-forward
       (rx point (+ (| word (syntax symbol) ".")) symbol-end)
-      (line-end-position) t)
+      (line-end-position) 'no-error)
      (match-end 0))))
 
 (defun haskell-tng--hsinspect-ghcflags ()
@@ -116,12 +113,10 @@ A prefix argument ensures that caches are flushes."
         (insert-file-contents (expand-file-name ".ghc.flags"))
         (split-string
          (buffer-substring-no-properties (point-min) (point-max))))
-    (user-error "could not find `.ghc.flags'.")))
+    (user-error "could not find `.ghc.flags': add GhcFlags.Plugin and 
compile.")))
 
-(defvar-local haskell-tng--hsinspect-imports nil
-  "Cache for the last `imports' call for this buffer.
-t means the process failed.")
-(defun haskell-tng--hsinspect-imports (no-work flush-cache)
+(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)
@@ -130,10 +125,9 @@ t means the process failed.")
    no-work
    flush-cache))
 
-(defvar-local haskell-tng--hsinspect-index nil
-  "Cache for the last `index' call for this buffer.
-t means the process failed.")
-(defun haskell-tng--hsinspect-index (flush-cache)
+;; TODO use a package specific variable buffer to save memory
+(defvar-local haskell-tng--hsinspect-index nil)
+(defun haskell-tng--hsinspect-index (&optional flush-cache)
   (when-let (ghcflags-dir
              (locate-dominating-file default-directory ".ghc.flags"))
     (haskell-tng--hsinspect-cached
@@ -144,7 +138,7 @@ t means the process failed.")
      nil
      flush-cache)))
 
-;; FIXME use a cache
+;; FIXME use a project-wide cache
 (defvar-local haskell-tng--hsinspect-exe nil)
 (defvar haskell-tng--hsinspect-which-hsinspect
   "cabal exec -v0 which -- hsinspect")
@@ -157,7 +151,7 @@ t means the process failed.")
     (let ((which (string-trim (shell-command-to-string 
haskell-tng--hsinspect-which-hsinspect))))
       (if (file-exists-p which)
           which
-        ;; fall back to system installed binary
+        ;; TODO don't do this, prefer an error message
         "hsinspect")))))
 
 (defun haskell-tng--hsinspect (&rest params)
@@ -169,7 +163,6 @@ t means the process failed.")
             (let ((process-environment (cons "GHC_ENVIRONMENT=-" 
process-environment)))
               (apply
                #'call-process
-               ;; TODO async
                (haskell-tng--hsinspect-exe)
                nil "*hsinspect*" nil
                (append params '("--") ghcflags))))
@@ -178,7 +171,7 @@ t means the process failed.")
         ;; TODO remove this resilience against stdout / stderr noise
         (goto-char (point-max))
         (backward-sexp)
-        (or (ignore-errors (read (current-buffer))) t)))))
+        (ignore-errors (read (current-buffer)))))))
 
 (provide 'haskell-tng-hsinspect)
 ;;; haskell-tng-hsinspect.el ends here
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index d7f93a8..25733cc 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -95,23 +95,29 @@ 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.
-The caller is responsible for flushing the cache.
+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
 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.
+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.
+Errors are not cached, nil return values are cached in LOCAL but
+not in DISK.
 
 NO-WORK skips FN and only queries the caches.
 
@@ -120,34 +126,27 @@ FLUSH-CACHE forces both LOCAL and DISK to be invalidated."
     (set local nil))
   (when (not (symbol-value local))
     (let ((cache-file-name
-           (concat (xdg-cache-home) "/" disk)))
+           (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
-           (progn
-             ;; TODO remove this check, it's just for debugging
-             (if (or
-                  (buffer-modified-p)
-                  (time-less-p
-                   (file-attribute-modification-time (file-attributes 
cache-file-name))
-                   (file-attribute-modification-time (file-attributes 
buffer-file-name))))
-                 (message "loading %S cache older than the current buffer" 
(car args))
-               (message "loading %S cache" (car args)))
-             (with-temp-buffer
-               (insert-file-contents cache-file-name)
-               (goto-char (point-min))
-               (ignore-errors (read (current-buffer))))))
+           (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))
-          (unless local (set local 'cached-nil))
-          (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))))))))
+          (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)))