branch: elpa/haskell-tng-mode
commit 35d383078e53227d3aa550d628abf6c461459219
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@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)))
