[nongnu] elpa/haskell-tng-mode e73bc19 335/385: jump-to-definition

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit e73bc19ffd61a3b829d06bfcf35b9b292087d82c
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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
 
 ![screencast of 
haskell-tng-import-symbol-at-point](screencasts/import-symbol-at-point.gif)
 
+To jump to the definition of a symbol defined outside the project, use `M-x 
haskell-tng-jump-to-definition`.
+
+![screencast of 
haskell-tng-jump-to-definition](screencasts/jump-to-definition.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 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