branch: elpa/haskell-tng-mode
commit b46dbd1084f6a7410ba43f8050f234a20396e0f3
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
refactoring of the cache for more reuse later
---
haskell-tng-extra-company.el | 2 +-
haskell-tng-hsinspect.el | 69 +++++++++-----------------------------------
haskell-tng-util.el | 58 +++++++++++++++++++++++++++++++++++++
3 files changed, 72 insertions(+), 57 deletions(-)
diff --git a/haskell-tng-extra-company.el b/haskell-tng-extra-company.el
index 8dc1f7d..54304d1 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 nil nil)))
+ (haskell-tng--hsinspect-imports 'no-work nil)))
('sorted t)
('duplicates t)
;; TODO 'meta return the FQN
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index a3a46b4..c6b638b 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -15,7 +15,6 @@
;; with pre-canned data.
(require 'subr-x)
-(require 'xdg)
;; Popups are not supported in stock Emacs so an extension is necessary:
;; https://emacs.stackexchange.com/questions/53373
@@ -37,7 +36,7 @@ A prefix argument ensures that caches are flushes."
(if-let* ((sym (haskell-tng--hsinspect-symbol-at-point))
(found (seq-find
(lambda (names) (member sym (seq-map #'cdr names)))
- (haskell-tng--hsinspect-imports 'allow-work alt))))
+ (haskell-tng--hsinspect-imports nil alt))))
;; TODO multiple hits
;; TODO feedback when hsinspect is broken
(popup-tip (format "%s" (cdar (last found))))
@@ -122,12 +121,13 @@ A prefix argument ensures that caches are flushes."
(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 (allow-work flush-cache)
- (haskell-tng--hsinspect-cached-cmd
- 'haskell-tng--hsinspect-imports
- (concat buffer-file-name "." "imports")
+(defun haskell-tng--hsinspect-imports (no-work flush-cache)
+ (haskell-tng--hsinspect-cached
+ #'haskell-tng--hsinspect
`("imports" ,buffer-file-name)
- allow-work
+ 'haskell-tng--hsinspect-imports
+ (concat "hsinspect-0.0.7" buffer-file-name "." "imports")
+ no-work
flush-cache))
(defvar-local haskell-tng--hsinspect-index nil
@@ -136,58 +136,15 @@ t means the process failed.")
(defun haskell-tng--hsinspect-index (flush-cache)
(when-let (ghcflags-dir
(locate-dominating-file default-directory ".ghc.flags"))
- (haskell-tng--hsinspect-cached-cmd
- 'haskell-tng--hsinspect-index
- (concat (expand-file-name ghcflags-dir) ".index")
+ (haskell-tng--hsinspect-cached
+ #'haskell-tng--hsinspect
'("index")
- t
+ 'haskell-tng--hsinspect-index
+ (concat "hsinspect-0.0.7" (expand-file-name ghcflags-dir) "index")
+ nil
flush-cache)))
-(defun haskell-tng--hsinspect-cached-cmd (buffer-local-cache
- disk-cache
- args
- allow-work flush-cache)
- (when flush-cache
- (set buffer-local-cache nil))
- (when (not (symbol-value buffer-local-cache))
- (let ((cache-file-name
- (concat
- (xdg-cache-home) "/"
- "hsinspect-0.0.7/"
- disk-cache)))
- ;; user is responsible for flushing caches.
- (when (and flush-cache (file-exists-p cache-file-name))
- (delete-file cache-file-name))
- (if (file-exists-p cache-file-name)
- (set
- buffer-local-cache
- (progn
- ;; TODO decide if we want to keep this check, it's mostly 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 hsinspect cache older than the current
buffer")
- (message "loading hsinspect cache"))
- (with-temp-buffer
- (insert-file-contents cache-file-name)
- (goto-char (point-min))
- (ignore-errors (read (current-buffer))))))
- (unless (or (not allow-work)
- (eq t (symbol-value buffer-local-cache)))
- (set buffer-local-cache t)
- (set buffer-local-cache (apply #'haskell-tng--hsinspect args))
- (let ((cache (symbol-value buffer-local-cache)))
- (unless (eq t cache)
- (with-temp-file cache-file-name
- (make-directory (file-name-directory cache-file-name) t)
- (prin1 cache (current-buffer)))))))))
-
- (when (not (eq t (symbol-value buffer-local-cache)))
- (symbol-value buffer-local-cache)))
-
-;; TODO cache per project (or package at least)
+;; FIXME use a cache
(defvar-local haskell-tng--hsinspect-exe nil)
(defvar haskell-tng--hsinspect-which-hsinspect
"cabal exec -v0 which -- hsinspect")
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 96bd3f0..d7f93a8 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -12,6 +12,7 @@
;; TODO move things to single use sites (twas premature abstraction!)
(require 'subr-x)
+(require 'xdg)
(defun haskell-tng--util-paren-close (&optional pos)
"The next `)', if it closes `POS's paren depth."
@@ -94,5 +95,62 @@ and taking a regexp."
(concat "qualified " module " as " as)))
"\n")))
+;; 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.
+
+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.
+
+Otherwise FN is called with ARGS and saved to both LOCAL and
+DISK.
+
+Errors are not cached, nil return values are cached.
+
+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) "/" disk)))
+ (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))))))
+ (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))))))))
+
+ (when (not (eq 'cached-nil (symbol-value local)))
+ (symbol-value local)))
+
(provide 'haskell-tng-util)
;;; haskell-tng-util.el ends here
