branch: elpa/haskell-tng-mode
commit e73bc19ffd61a3b829d06bfcf35b9b292087d82c
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
jump-to-definition
---
README.md | 11 +++-
haskell-tng-extra-projectile.el | 1 +
haskell-tng-extra.el | 2 +-
haskell-tng-hsinspect.el | 102 ++++++++++++++++++++++++++----
haskell-tng-util.el | 4 +-
screencasts/jump-to-definition.gif | Bin 0 -> 43475 bytes
screencasts/jump-to-definition.mp4 | Bin 0 -> 218087 bytes
test/data/hsinspect-0.0.7-imports.sexp.gz | Bin 364 -> 0 bytes
test/data/hsinspect-0.0.7-index.sexp.gz | Bin 52239 -> 0 bytes
test/data/hsinspect-0.0.8-index.sexp.gz | Bin 74636 -> 0 bytes
test/data/hsinspect-0.0.9-index.sexp.gz | Bin 0 -> 73914 bytes
test/haskell-tng-hsinspect-test.el | 24 ++++---
12 files changed, 114 insertions(+), 30 deletions(-)
diff --git a/README.md b/README.md
index c8fb8fc..e051fb2 100644
--- a/README.md
+++ b/README.md
@@ -68,7 +68,7 @@ The optional command line tool
[`hsinspect`](https://gitlab.com/tseenshe/hsinspe
To use this feature you must install `hsinspect` command line tool and the
`ghcflags` plugin to every `.cabal` file:
-1. `build-tool-depends: hsinspect:hsinspect == 0.0.8` (or make `hsinspect`
available globally, self-managing `ghc` versions)
+1. `build-tool-depends: hsinspect:hsinspect == 0.0.9` (or make `hsinspect`
available globally, self-managing `ghc` versions)
2. `build-depends: ghcflags == 1.0.2`
3. add `ghc-options: -fplugin GhcFlags.Plugin`
@@ -79,6 +79,7 @@ recordmydesktop --no-sound --delay 3
ffmpeg -i out.ogv -vf crop=500:300:5:0 fqn-at-point-completion.mp4
ffmpeg -i out.ogv -vf crop=500:300:5:0,scale=300:-1 -hide_banner
fqn-at-point-completion.gif
+
gitlab markdown allows embedded mp4s but it makes them huge, so use gifs
-->
@@ -88,6 +89,10 @@ To automatically import a symbol at point, use `M-x
haskell-tng-import-symbol-at
+To jump to the definition of a symbol defined outside the project, use `M-x
haskell-tng-jump-to-definition`.
+
+
+
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 hsinspect.
## Extras
@@ -103,6 +108,8 @@ Third party Haskell tools must be installed separately
(e.g. via `cabal v2-insta
- [`ormolu`](https://github.com/tweag/ormolu)
- `C-c p R` invoke
[`fast-tags`](https://hackage.haskell.org/package/fast-tags) via
[`projectile`](https://github.com/bbatsov/projectile)
+Note that to jump to definition inside the project, use
`projectile-regenerate-tags` and `projectile-find-tag`.
+
## Contributing
Bug reports and feature requests are a source of anxiety for me, and encourage
an unhealthy customer / supplier relationship between users and contributors.
@@ -137,7 +144,6 @@ This is the status of core features:
- `lsp-mode` /
[`haskell-ide-engine`](https://github.com/haskell/haskell-ide-engine) for more
advanced IDE features.
- Imports
- - quick manual add `import`
- company-mode backend specific to import sections that detect context,
powered by local hoogle cli
- expand import list into explicit list (perhaps via `:browse` but better as
standalone tool) for symbol-at-point (assuming no shadowing).
- convert wildcard import to explicit list
@@ -146,7 +152,6 @@ This is the status of core features:
- visual indicator of what has been exported (hsinspect could do this for
compilable code)
- Hoogle integration
- build local hoogle database for a project
- - local cli jump-to-source of symbol-at-point / type-at-point (i.e. explicit
fully qualified name)
- local cli search
- local / remote search with doc in browser
- `.cabal` editing / navigation
diff --git a/haskell-tng-extra-projectile.el b/haskell-tng-extra-projectile.el
index d3d28cc..1beac1c 100644
--- a/haskell-tng-extra-projectile.el
+++ b/haskell-tng-extra-projectile.el
@@ -11,6 +11,7 @@
;; TODO fix the haskell-stack detection to also include cabal
;; TODO populate the projectile compile/run/test commands
+;; TODO haskell-tng-jump-to-definition-fallback
(make-variable-buffer-local 'projectile-tags-command)
(add-hook
diff --git a/haskell-tng-extra.el b/haskell-tng-extra.el
index 7eb1353..c6f0dbb 100644
--- a/haskell-tng-extra.el
+++ b/haskell-tng-extra.el
@@ -115,7 +115,7 @@ When in a comment and called with a prefix, the comment
will be completed."
"Adds an unqualified wildcard import."
;; TODO autocomplete on available imports
(interactive "s")
- (haskell-tng--import-symbol module nil nil))
+ (haskell-tng--util-import-symbol module nil nil))
;;;###autoload
(defun haskell-tng-current-module ()
diff --git a/haskell-tng-hsinspect.el b/haskell-tng-hsinspect.el
index 10a95bb..37fbf09 100644
--- a/haskell-tng-hsinspect.el
+++ b/haskell-tng-hsinspect.el
@@ -44,7 +44,86 @@ A prefix argument ensures that caches are flushes."
(popup-tip (format "%s" found)))
(user-error "Not found"))
-;; TODO jump-to-definition using import + index + heuristics
+;;;###autoload
+(defun haskell-tng-jump-to-definition (&optional alt)
+ "Consult the `imports' in scope to calculate the symbol at point,
+then find the package using the `index', then visit the
+definition of the symbol in the build tool's source archive.
+
+TODO: support local / git packages by consulting `plan.json'"
+ (interactive "P")
+ ;; TODO better error reporting when any of these things fail
+ (when-let* ((imports (haskell-tng--hsinspect-imports nil alt))
+ (index (haskell-tng--hsinspect-index alt))
+ ;; TODO imports and index can be calculated in parallel
+ (sym (haskell-tng--hsinspect-symbol-at-point))
+ (found (haskell-tng--hsinspect-qualify imports sym))
+ (parts (haskell-tng--string-split-last found "."))
+ (module (car parts))
+ (name (cdr parts))
+ (srcid (haskell-tng--hsinspect-find-srcid index module))
+ (tarball (haskell-tng--hsinspect-srcid-source srcid))
+ (file (concat
+ ;; TODO string-replace would be nice...
+ (mapconcat 'identity (split-string module (rx ".")) "/" )
+ ".hs")))
+ (when (not (file-exists-p tarball))
+ ;; NOTE we can't do this with stack because it doesn't have the
equivalent
+ ;; of the "get" command. Also, it is not clear where stack puts source
+ ;; code, so no point looking.
+ ;;
+ ;; WORKAROUND https://github.com/haskell/cabal/issues/6443
+ (shell-command (format "cabal get %s -d /var/empty &" srcid))
+ (error "%s was not found, attempting to download: please try again
later" tarball))
+
+ (message "Loading %s from %s" sym tarball)
+ ;; TODO follow re-exports
+ (find-file tarball)
+ (let ((archive (current-buffer)))
+ (goto-char (point-min))
+ (re-search-forward (rx-to-string `(: (* any) ,file)))
+ (tar-extract)
+ (kill-buffer archive)
+ (read-only-mode 1)
+ (goto-char (point-min))
+ ;; TODO re-use the imenu top-level parser
+ ;; avoid false positives in export lists
+ (re-search-forward (rx line-start "import" word-end) nil t)
+ ;; will unfortunately find first uses
+ (or
+ (re-search-forward (rx-to-string `(: (| bol "| " "data " "type " "class
") ,name symbol-end)))
+ (re-search-forward (rx-to-string `(: symbol-start ,name
symbol-end)))))))
+
+(defun haskell-tng--string-split-last (str sep)
+ "Return `(front . back)' of a STR split on the last SEP."
+ ;; TODO optimise
+ (let* ((parts (split-string str (regexp-quote sep)))
+ (front (mapconcat 'identity (butlast parts) sep))
+ (back (car (last parts))))
+ (cons front back)))
+
+(defun haskell-tng--hsinspect-srcid-source (srcid)
+ (let* ((parts (haskell-tng--string-split-last srcid "-"))
+ (package (car parts))
+ (version (cdr parts)))
+ (expand-file-name
+ (concat "~/.cabal/packages/hackage.haskell.org/" package "/" version "/"
srcid ".tar.gz"))))
+
+;; TODO expose the inplace information instead of filtering
+(defun haskell-tng--hsinspect-find-srcid (index module)
+ ;; requires 0.0.9+
+ (alist-get
+ 'srcid
+ (seq-find
+ (lambda (pkg-entry)
+ (when (not (alist-get 'inplace pkg-entry))
+ (seq-find
+ (lambda (module-entry)
+ (equal module (alist-get 'module module-entry)))
+ (alist-get 'modules pkg-entry))))
+ index)))
+
+;; TODO haskell-tng-show-documentation
(defvar-local haskell-tng-hsinspect-as
;; TODO populate with even more than this
@@ -82,8 +161,8 @@ Respects the `C-u' cache invalidation convention."
;; TODO add parens around operators (or should that be in the utility?)
(let (qual
(flush-cache (and alt (not (eq '- alt)))))
- (when-let* ((index (haskell-tng--hsinspect-index flush-cache))
- (sym (haskell-tng--hsinspect-symbol-at-point)))
+ (when-let ((index (haskell-tng--hsinspect-index flush-cache))
+ (sym (haskell-tng--hsinspect-symbol-at-point)))
(message "Seaching for '%s' in %s modules" sym (length index))
(when (string-match (rx bos (group (+ anything)) "." (group (+ (not (any
".")))) eos) sym)
@@ -135,7 +214,7 @@ Respects the `C-u' cache invalidation convention."
(let* ((name (alist-get 'name entry))
(type (alist-get 'type entry))
(id (pcase (alist-get 'class entry)
- ((or 'id 'con) name)
+ ((or 'id 'con 'pat) name)
('tycon type)))
(full (concat module "." id)))
(if as
@@ -180,13 +259,14 @@ Respects the `C-u' cache invalidation convention."
;; entries to the user. We should dedupe that to just the cons unless we have a
;; way to make the choice clearer.
(defun haskell-tng--hsinspect-import-candidates (index sym)
- "Return an list of alists with keys: unitid, module, name, type.
-When using hsinspect-0.0.8, also: class, export, flavour."
+ "Return an list of alists with keys: module, name, type.
+When using hsinspect-0.0.8, also: class, export, flavour.
+When using hsinspect-0.0.9, also: srcid."
;; TODO threading/do syntax
;; TODO alist variable binding like RecordWildcards
(seq-mapcat
(lambda (pkg-entry)
- (let ((unitid (alist-get 'unitid pkg-entry))
+ (let ((srcid (alist-get 'srcid pkg-entry))
(modules (alist-get 'modules pkg-entry)))
(seq-mapcat
(lambda (module-entry)
@@ -200,7 +280,7 @@ When using hsinspect-0.0.8, also: class, export, flavour."
(export (alist-get 'export entry))
(flavour (alist-get 'flavour entry)))
(when (or (equal name sym) (equal type sym))
- `(((unitid . ,unitid)
+ `(((srcid . ,srcid)
(module . ,module)
(name . ,name)
(type . ,type)
@@ -246,7 +326,7 @@ When using hsinspect-0.0.8, also: class, export, flavour."
(defvar-local haskell-tng--hsinspect-imports nil)
(defun haskell-tng--hsinspect-imports (&optional no-work flush-cache)
- (haskell-tng--hsinspect-cached
+ (haskell-tng--util-cached
(lambda () (haskell-tng--hsinspect flush-cache "imports" buffer-file-name))
'haskell-tng--hsinspect-imports
(concat "hsinspect-0.0.7" buffer-file-name "." "imports")
@@ -257,7 +337,7 @@ When using hsinspect-0.0.8, also: class, export, flavour."
"Add the import to the current buffer and update
`haskell-tng--hsinspect-imports'.
Does not persist the cache changes to disk."
- (haskell-tng--import-symbol module as sym)
+ (haskell-tng--util-import-symbol module as sym)
(let ((updates (haskell-tng--hsinspect-extract-imports index module as sym)))
(setq haskell-tng--hsinspect-imports
(append haskell-tng--hsinspect-imports updates))))
@@ -294,7 +374,7 @@ Does not persist the cache changes to disk."
"Finds and checks the hsinspect binary for the current buffer.
This is uncached, prefer `haskell-tng--hsinspect-exe'."
- (let ((supported '("0.0.7" "0.0.8" "0.0.9"))
+ (let ((supported '("0.0.7" "0.0.8" "0.0.9" "0.0.10"))
(bin
(car
(last
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index c43f0c8..32a591a 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -71,7 +71,7 @@ and taking a regexp."
(while (not (setq ,res ,test)) ,@body)
,res)))
-(defun haskell-tng--import-symbol (module &optional as sym)
+(defun haskell-tng--util-import-symbol (module &optional as sym)
"Adds an import for MODULE."
;; TODO outsource to `hsimport' when it does de-duping and formatting.
(save-excursion
@@ -96,7 +96,7 @@ and taking a regexp."
"\n")))
;; TODO needs a unit test
-(defun haskell-tng--hsinspect-cached
+(defun haskell-tng--util-cached
(work sym key &optional no-work reset)
"A two-tier (variable and disk-based) cache over WORK.
diff --git a/screencasts/jump-to-definition.gif
b/screencasts/jump-to-definition.gif
new file mode 100644
index 0000000..3997d7a
Binary files /dev/null and b/screencasts/jump-to-definition.gif differ
diff --git a/screencasts/jump-to-definition.mp4
b/screencasts/jump-to-definition.mp4
new file mode 100644
index 0000000..dcf7624
Binary files /dev/null and b/screencasts/jump-to-definition.mp4 differ
diff --git a/test/data/hsinspect-0.0.7-imports.sexp.gz
b/test/data/hsinspect-0.0.7-imports.sexp.gz
deleted file mode 100644
index dc6b7ac..0000000
Binary files a/test/data/hsinspect-0.0.7-imports.sexp.gz and /dev/null differ
diff --git a/test/data/hsinspect-0.0.7-index.sexp.gz
b/test/data/hsinspect-0.0.7-index.sexp.gz
deleted file mode 100644
index aad2677..0000000
Binary files a/test/data/hsinspect-0.0.7-index.sexp.gz and /dev/null differ
diff --git a/test/data/hsinspect-0.0.8-index.sexp.gz
b/test/data/hsinspect-0.0.8-index.sexp.gz
deleted file mode 100644
index 6e95415..0000000
Binary files a/test/data/hsinspect-0.0.8-index.sexp.gz and /dev/null differ
diff --git a/test/data/hsinspect-0.0.9-index.sexp.gz
b/test/data/hsinspect-0.0.9-index.sexp.gz
new file mode 100644
index 0000000..f97612a
Binary files /dev/null and b/test/data/hsinspect-0.0.9-index.sexp.gz differ
diff --git a/test/haskell-tng-hsinspect-test.el
b/test/haskell-tng-hsinspect-test.el
index 803f77e..a4653f6 100644
--- a/test/haskell-tng-hsinspect-test.el
+++ b/test/haskell-tng-hsinspect-test.el
@@ -37,29 +37,27 @@
(ert-deftest haskell-tng-hsinspect-test-import-candidates-latest ()
(let ((index
(haskell-tng--util-read
- (testdata "data/hsinspect-0.0.8-index.sexp.gz"))))
+ (testdata "data/hsinspect-0.0.9-index.sexp.gz"))))
;; function search
(should
(equal
(haskell-tng--hsinspect-import-candidates index "throw")
- '(((unitid . "base")
+ '(((srcid . "base-4.12.0.0")
(module . "Control.Exception.Base")
(name . "throw")
(type . "forall a e. Exception e => e -> a")
(class . id)
- (export (unitid . "base")
- (module . "GHC.Exception"))
+ (export (module . "GHC.Exception"))
(flavour))
- ((unitid . "base")
+ ((srcid . "base-4.12.0.0")
(module . "Control.Exception")
(name . "throw")
(type . "forall a e. Exception e => e -> a")
(class . id)
- (export (unitid . "base")
- (module . "GHC.Exception"))
+ (export (module . "GHC.Exception"))
(flavour))
- ((unitid . "base")
+ ((srcid . "base-4.12.0.0")
(module . "GHC.Exception")
(name . "throw")
(type . "forall a e. Exception e => e -> a")
@@ -71,7 +69,7 @@
(should
(equal
(haskell-tng--hsinspect-import-candidates index ">$<")
- '(((unitid . "base")
+ '(((srcid . "base-4.12.0.0")
(module . "Data.Functor.Contravariant")
(name . ">$<")
(type . "forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b
-> f a")
@@ -83,7 +81,7 @@
(should
(equal
(haskell-tng--hsinspect-import-candidates index "Contravariant")
- '(((unitid . "base")
+ '(((srcid . "base-4.12.0.0")
(module . "Data.Functor.Contravariant")
(name)
(type . "Contravariant")
@@ -93,12 +91,14 @@
;; TODO constructor search
;;(message "%S" (haskell-tng--hsinspect-import-candidates index
"Contravariant"))
+
+ ;; TODO pattern synonym search
))
(ert-deftest haskell-tng-hsinspect-test-extract-imports ()
(let ((index
(haskell-tng--util-read
- (testdata "data/hsinspect-0.0.8-index.sexp.gz"))))
+ (testdata "data/hsinspect-0.0.9-index.sexp.gz"))))
;; explicit import
(should
@@ -130,6 +130,4 @@
(full . "Data.List.and")))))
))
-;; TODO tests for 0.0.7 data
-
;;; haskell-tng-hsinspect-test.el ends here
