Separating out hcel-minor mode to avoid recursive requires

7 files changed, 189 insertions, 157 deletions

diff --git a/hcel-client.el b/hcel-client.el
index 3af6882..532fc88 100644
--- a/hcel-client.el
+++ b/hcel-client.el
@@ -68,6 +68,26 @@
               (name (alist-get 'name approx-location-info)))
     (hcel-api-definition-site package-id component-id module-name entity name)))
 
+(defun hcel-approx-to-exact-location (approx-location-info)
+  "Fetch exact location given approximate location.
+
+Example of approximate location:
+
+      \"locationInfo\": {
+        \"componentId\": \"exe-haskell-code-server\",
+        \"entity\": \"Typ\",
+        \"haddockAnchorId\": \"PackageInfo\",
+        \"moduleName\": \"HaskellCodeExplorer.Types\",
+        \"name\": \"PackageInfo\",
+        \"packageId\": {
+          \"name\": \"haskell-code-explorer\",
+          \"version\": \"0.1.0.0\"
+        },
+        \"tag\": \"ApproximateLocation\"
+      }"
+  (alist-get 'location
+             (hcel-definition-site-location-info approx-location-info)))
+
 (defun hcel-api-module-info (package-id module-path)
   (hcel-url-fetch-json
    (concat
diff --git a/hcel-minor.el b/hcel-minor.el
new file mode 100644
index 0000000..b507ef4
--- /dev/null
+++ b/hcel-minor.el
@@ -0,0 +1,143 @@
+;;; hcel-minor.el --- hcel-minor mode for definitions, references and eldoc. -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Free Software Foundation, Inc.
+;; 
+;; This file is part of hcel.
+;; 
+;; hcel is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;; 
+;; hcel is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+;; Public License for more details.
+;; 
+;; You should have received a copy of the GNU Affero General Public
+;; License along with hcel.  If not, see <https://www.gnu.org/licenses/>.
+
+(require 'hcel-source)
+(require 'hcel-results)
+(require 'hcel-outline)
+
+(defvar hcel-minor-major-modes
+  '(hcel-outline-mode hcel-ids-mode)
+  "Major modes where hcel-minor mode can live in.")
+
+(defvar hcel-minor-mode-map
+  (let ((kmap (make-sparse-keymap)))
+    (define-key kmap (kbd "M-?") #'hcel-minor-find-references-at-point)
+    kmap))
+
+(define-minor-mode hcel-minor-mode
+  "A minor mode for exploring haskell codebases."
+  :lighter " hcel-minor"
+  (add-hook 'xref-backend-functions
+            #'hcel-minor--xref-backend nil t)
+  (cond
+   ((null hcel-minor-mode)
+    (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-id-type t)
+    (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-docs t))
+   ((not (or (apply 'derived-mode-p hcel-minor-major-modes)
+             (eq (current-buffer) eldoc--doc-buffer)))
+    (setq hcel-minor-mode nil)
+    (error "Not in one of the supported modes (%s) or the eldoc buffer."
+           (mapconcat #'prin1-to-string hcel-minor-major-modes
+                      ", ")))
+   (t
+    (add-hook
+     'eldoc-documentation-functions #'hcel-minor-eldoc-docs nil t)
+    (add-hook
+     'eldoc-documentation-functions #'hcel-minor-eldoc-id-type nil t)
+    (setq-local eldoc-documentation-strategy 'eldoc-documentation-compose))))
+
+(defun hcel-minor-find-references-at-point ()
+  (interactive)
+  (cond ((or (derived-mode-p 'hcel-outline-mode)
+             (eq (current-buffer) eldoc--doc-buffer))
+         (hcel-find-references-internal
+          (hcel-text-property-near-point 'package-id)
+          (hcel-text-property-near-point 'module-path)
+          (hcel-text-property-near-point 'internal-id)))
+        ((derived-mode-p 'hcel-ids-mode)
+         (hcel-find-references-internal
+          (alist-get 'packageId (hcel-text-property-near-point 'location-info))
+          (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
+          (hcel-text-property-near-point 'internal-id)))
+        (t (error "%S not supported and not in eldoc doc buffer." major-mode))))
+
+(defun hcel-minor-eldoc-id-type (cb)
+  (when-let* ((identifier (hcel-text-property-near-point 'internal-id))
+              (symbol (save-excursion
+                        (buffer-substring
+                         (progn
+                           (text-property-search-backward
+                            'internal-id identifier 'string=)
+                           (point))
+                         (progn
+                           (text-property-search-forward
+                            'internal-id identifier 'string=)
+                           (point)))))
+              (docstring
+               (cond ((derived-mode-p 'hcel-outline-mode)
+                      (hcel-render-type-internal
+                       (hcel-text-property-near-point 'package-id)
+                       (hcel-text-property-near-point 'module-path)
+                       identifier))
+                     ((derived-mode-p 'hcel-ids-mode)
+                      (hcel-render-type-internal
+                       (alist-get 'packageId (hcel-text-property-near-point 'location-info))
+                       (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
+                       identifier))
+                     (t nil))))
+    (funcall cb docstring
+             :thing symbol
+             :face 'font-lock-variable-name-face)
+    (with-current-buffer eldoc--doc-buffer
+      (hcel-minor-mode 1))))
+
+(defun hcel-minor-eldoc-docs (cb)
+  (when-let* ((docstring
+               (cond ((derived-mode-p 'hcel-outline-mode)
+                      (hcel-id-docs-internal
+                       (hcel-text-property-near-point 'package-id)
+                       (hcel-text-property-near-point 'module-path)
+                       (hcel-text-property-near-point 'internal-id)))
+                     ((derived-mode-p 'hcel-ids-mode)
+                      (hcel-id-docs-internal
+                       (alist-get 'packageId (hcel-text-property-near-point 'location-info))
+                       (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
+                       (hcel-text-property-near-point 'internal-id)))
+                     (t nil))))
+    (setq this-command nil)
+    (funcall cb docstring)
+    (with-current-buffer eldoc--doc-buffer
+      (hcel-minor-mode))))
+
+(add-hook 'hcel-ids-mode-hook (lambda () (hcel-minor-mode 1)))
+(add-hook 'hcel-outline-mode-hook (lambda () (hcel-minor-mode 1)))
+
+(add-hook 'hcel-eldoc-hook (lambda ()
+                             (with-current-buffer eldoc--doc-buffer
+                               (hcel-minor-mode 1))))
+
+(defun hcel-minor--xref-backend () 'hcel-minor-xref)
+(cl-defmethod xref-backend-definitions ((_backend (eql hcel-minor-xref)) _identifiers)
+  (hcel-minor-find-definition-at-point))
+(defun hcel-minor-find-definition-at-point ()
+  (interactive)
+  (cond ((or (derived-mode-p 'hcel-outline-mode)
+             (eq (current-buffer) eldoc--doc-buffer))
+         (hcel-find-definition-internal
+          (hcel-text-property-near-point 'package-id)
+          (hcel-text-property-near-point 'module-path)
+          (hcel-text-property-near-point 'internal-id)))
+        ((derived-mode-p 'hcel-ids-mode)
+         (hcel-find-definition-internal
+          (alist-get 'packageId (hcel-text-property-near-point 'location-info))
+          (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
+          (hcel-text-property-near-point 'internal-id)))
+        (t (error "%S not supported and not in eldoc doc buffer." major-mode))))
+
+(provide 'hcel-minor)
diff --git a/hcel-outline.el b/hcel-outline.el
index 962e5aa..a192e07 100644
--- a/hcel-outline.el
+++ b/hcel-outline.el
@@ -20,6 +20,7 @@
 (require 'hcel-utils)
 (require 'hcel-source)
 (require 'outline)
+(require 'text-property-search)
 
 (defvar hcel-outline-buffer-name "*hcel-outline*")
 (defvar hcel-outline-indentation 2)
@@ -42,8 +43,7 @@
   (setq-local outline-regexp "\\( *\\)."
               outline-level (lambda () (1+ (/ (length (match-string 1))
                                               hcel-outline-indentation)))
-              buffer-read-only t)
-  (hcel-minor-mode 1))
+              buffer-read-only t))
 
 (defun hcel ()
   (interactive)
@@ -62,9 +62,22 @@
                     "\n")))
          (hcel-api-packages)))
       (hcel-outline-mode))))
-
 (define-key hcel-mode-map "o" #'hcel)
 
+(defun hcel-outline-package-module ()
+  (interactive)
+  (unless (derived-mode-p 'hcel-mode)
+    (error "Not in hcel mode!"))
+  (let ((package-id hcel-package-id)
+        (module-path hcel-module-path))
+    (hcel)
+    (hcel-outline-goto-package package-id)
+    (hcel-outline-load-modules-at-point)
+    (hcel-outline-goto-module module-path)
+    (hcel-outline-load-identifiers-at-point)))
+(define-key hcel-mode-map "O" #'hcel-outline-package-module)
+
+
 ;; TODO: maybe remove
 (defun hcel-outline-update-opened (package-id module-path)
   "Update the outline tree depending on openness of packages and modules.
diff --git a/hcel-results.el b/hcel-results.el
index 6d6c2c9..3ebee43 100644
--- a/hcel-results.el
+++ b/hcel-results.el
@@ -212,21 +212,6 @@ Start by choosing a package."
                                  (hcel-text-property-near-point 'identifier)))
 (define-key hcel-mode-map (kbd "M-?") #'hcel-find-references-at-point)
 
-(defun hcel-minor-find-references-at-point ()
-  (interactive)
-  (cond ((or (derived-mode-p 'hcel-outline-mode)
-             (eq (current-buffer) eldoc--doc-buffer))
-         (hcel-find-references-internal
-          (hcel-text-property-near-point 'package-id)
-          (hcel-text-property-near-point 'module-path)
-          (hcel-text-property-near-point 'internal-id)))
-        ((derived-mode-p 'hcel-ids-mode)
-         (hcel-find-references-internal
-          (alist-get 'packageId (hcel-text-property-near-point 'location-info))
-          (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
-          (hcel-text-property-near-point 'internal-id)))
-        (t (error "%S not supported and not in eldoc doc buffer." major-mode))))
-
 (defun hcel-find-references-internal (package-id module-path identifier)
   (when (and package-id module-path identifier)
     (let ((hcel-buffer (hcel-buffer-name package-id module-path)))
@@ -258,8 +243,7 @@ Start by choosing a package."
 
 (define-compilation-mode hcel-ids-mode "hcel-ids"
   "Major mode for showing identifiers"
-  (setq-local next-error-function #'hcel-results-next-error)
-  (hcel-minor-mode 1))
+  (setq-local next-error-function #'hcel-results-next-error))
 
 (defun hcel-ids-update ()
   (unless (derived-mode-p 'hcel-ids-mode)
diff --git a/hcel-source.el b/hcel-source.el
index f6e5d55..905950c 100644
--- a/hcel-source.el
+++ b/hcel-source.el
@@ -20,8 +20,7 @@
 (require 'array)
 (require 'dom)
 (require 'hcel-client)
-(require 'hcel-outline)
-(require 'hcel-results)
+(require 'text-property-search)
 (require 'xref)
 
 (defvar-local hcel-identifiers nil)
@@ -223,18 +222,9 @@ the location with pulsing.
           (unless (length= expr 0)
             (hcel-expression-and-type (elt expr (1- (length expr))))))))))
 
-(defun hcel-outline-package-module ()
-  (interactive)
-  (let ((package-id hcel-package-id)
-        (module-path hcel-module-path))
-    (hcel)
-    (hcel-outline-goto-package package-id)
-    (hcel-outline-load-modules-at-point)
-    (hcel-outline-goto-module module-path)
-    (hcel-outline-load-identifiers-at-point)))
-(define-key hcel-mode-map "O" #'hcel-outline-package-module)
-
 ;; eldoc
+(defvar hcel-eldoc-hook nil)
+
 (defun hcel-eldoc-id-type (cb)
   (when-let ((symbol (hcel-occ-symbol-at-point))
              (doc (hcel-type-at-point))
@@ -246,63 +236,13 @@ the location with pulsing.
     (funcall cb docstring
              :thing symbol
              :face 'font-lock-variable-name-face)
-    (with-current-buffer eldoc--doc-buffer
-      (hcel-minor-mode))))
-
-(defun hcel-minor-eldoc-id-type (cb)
-  (when-let* ((identifier (hcel-text-property-near-point 'internal-id))
-              (symbol (save-excursion
-                        (buffer-substring
-                         (progn
-                           (text-property-search-backward
-                            'internal-id identifier 'string=)
-                           (point))
-                         (progn
-                           (text-property-search-forward
-                            'internal-id identifier 'string=)
-                           (point)))))
-              (docstring
-               (cond ((derived-mode-p 'hcel-outline-mode)
-                      (hcel-render-type-internal
-                       (hcel-text-property-near-point 'package-id)
-                       (hcel-text-property-near-point 'module-path)
-                       identifier))
-                     ((derived-mode-p 'hcel-ids-mode)
-                      (hcel-render-type-internal
-                       (alist-get 'packageId (hcel-text-property-near-point 'location-info))
-                       (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
-                       identifier))
-                     (t nil))))
-    (funcall cb docstring
-             :thing symbol
-             :face 'font-lock-variable-name-face)
-    (with-current-buffer eldoc--doc-buffer
-      (hcel-minor-mode))))
+    (run-hooks 'hcel-eldoc-hook)))
 
 (defun hcel-eldoc-docs (cb)
   (when-let ((docstring (hcel-id-docs-at-point)))
     (setq this-command nil)
     (funcall cb docstring)
-    (with-current-buffer eldoc--doc-buffer
-      (hcel-minor-mode))))
-
-(defun hcel-minor-eldoc-docs (cb)
-  (when-let* ((docstring
-               (cond ((derived-mode-p 'hcel-outline-mode)
-                      (hcel-id-docs-internal
-                       (hcel-text-property-near-point 'package-id)
-                       (hcel-text-property-near-point 'module-path)
-                       (hcel-text-property-near-point 'internal-id)))
-                     ((derived-mode-p 'hcel-ids-mode)
-                      (hcel-id-docs-internal
-                       (alist-get 'packageId (hcel-text-property-near-point 'location-info))
-                       (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
-                       (hcel-text-property-near-point 'internal-id)))
-                     (t nil))))
-    (setq this-command nil)
-    (funcall cb docstring)
-    (with-current-buffer eldoc--doc-buffer
-      (hcel-minor-mode))))
+    (run-hooks 'hcel-eldoc-hook)))
 
 (defun hcel-eldoc-expression-type (cb)
   (when mark-active
@@ -313,8 +253,7 @@ the location with pulsing.
       (funcall cb (cdr expr-and-type)
                :thing (car expr-and-type)
                :face 'font-lock-variable-name-face)
-      (with-current-buffer eldoc--doc-buffer
-        (hcel-minor-mode)))))
+      (run-hooks 'hcel-eldoc-hook))))
 
 ;; highlight
 (defface hcel-highlight-id '((t (:inherit underline)))
@@ -432,24 +371,6 @@ the location with pulsing.
    (hcel-text-property-near-point 'identifier)
    (hcel-text-property-near-point 'occurrence)))
 
-(defun hcel-minor--xref-backend () 'hcel-minor-xref)
-(cl-defmethod xref-backend-definitions ((_backend (eql hcel-minor-xref)) _identifiers)
-  (hcel-minor-find-definition-at-point))
-(defun hcel-minor-find-definition-at-point ()
-  (interactive)
-  (cond ((or (derived-mode-p 'hcel-outline-mode)
-             (eq (current-buffer) eldoc--doc-buffer))
-         (hcel-find-definition-internal
-          (hcel-text-property-near-point 'package-id)
-          (hcel-text-property-near-point 'module-path)
-          (hcel-text-property-near-point 'internal-id)))
-        ((derived-mode-p 'hcel-ids-mode)
-         (hcel-find-definition-internal
-          (alist-get 'packageId (hcel-text-property-near-point 'location-info))
-          (alist-get 'modulePath (hcel-text-property-near-point 'location-info))
-          (hcel-text-property-near-point 'internal-id)))
-        (t (error "%S not supported and not in eldoc doc buffer." major-mode))))
-
 (defun hcel-find-definition-internal (package-id module-path identifier
                                                  &optional occurrence)
   (when (and package-id module-path (or identifier occurrence))
@@ -487,37 +408,5 @@ the location with pulsing.
                   (t
                    (error "unimplemented: %s" (hcel-location-tag location-info))))))))))
 
-;; hcel-minor mode
-(defvar hcel-minor-major-modes
-  '(hcel-outline-mode hcel-ids-mode)
-  "Major modes where hcel-minor mode can live in.")
-
-(defvar hcel-minor-mode-map
-  (let ((kmap (make-sparse-keymap)))
-    (define-key kmap (kbd "M-?") #'hcel-minor-find-references-at-point)
-    kmap))
-
-(define-minor-mode hcel-minor-mode
-  "A minor mode for exploring haskell codebases."
-  :lighter " hcel-minor"
-  (add-hook 'xref-backend-functions
-            #'hcel-minor--xref-backend nil t)
-  (cond
-   ((null hcel-minor-mode)
-    (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-id-type t)
-    (remove-hook 'eldoc-documentation-functions #'hcel-minor-eldoc-docs t))
-   ((not (or (apply 'derived-mode-p hcel-minor-major-modes)
-             (eq (current-buffer) eldoc--doc-buffer)))
-    (setq hcel-minor-mode nil)
-    (error "Not in one of the supported modes (%s) or the eldoc buffer."
-           (mapconcat #'prin1-to-string hcel-minor-major-modes
-                      ", ")))
-   (t
-    (add-hook
-     'eldoc-documentation-functions #'hcel-minor-eldoc-docs nil t)
-    (add-hook
-     'eldoc-documentation-functions #'hcel-minor-eldoc-id-type nil t)
-    (setq-local eldoc-documentation-strategy 'eldoc-documentation-compose))))
-
 (provide 'hcel-source)
 ;;; hcel-source.el ends here.
diff --git a/hcel-utils.el b/hcel-utils.el
index 6d44a4c..3bd8841 100644
--- a/hcel-utils.el
+++ b/hcel-utils.el
@@ -28,26 +28,6 @@
   "Gets the tag of LOCATION-INFO."
   (alist-get 'tag location-info))
 
-(defun hcel-approx-to-exact-location (approx-location-info)
-  "Fetch exact location given approximate location.
-
-Example of approximate location:
-
-      \"locationInfo\": {
-        \"componentId\": \"exe-haskell-code-server\",
-        \"entity\": \"Typ\",
-        \"haddockAnchorId\": \"PackageInfo\",
-        \"moduleName\": \"HaskellCodeExplorer.Types\",
-        \"name\": \"PackageInfo\",
-        \"packageId\": {
-          \"name\": \"haskell-code-explorer\",
-          \"version\": \"0.1.0.0\"
-        },
-        \"tag\": \"ApproximateLocation\"
-      }"
-  (alist-get 'location
-             (hcel-definition-site-location-info approx-location-info)))
-
 (defun hcel-id-src-span-to-location-info (package-id module-path id-src-span)
   "Converts an idSrcSpan to an exact location.
 
diff --git a/hcel.el b/hcel.el
index 43da466..885668d 100644
--- a/hcel.el
+++ b/hcel.el
@@ -26,6 +26,9 @@
 ;; You should have received a copy of the GNU Affero General Public
 ;; License along with hcel.  If not, see <https://www.gnu.org/licenses/>.
 
+(require 'hcel-minor)
+(require 'hcel-outline)
+(require 'hcel-results)
 (require 'hcel-source)
 (require 'hcel-utils)