Separating out hcel-minor mode to avoid recursive requires

1 files changed, 6 insertions, 117 deletions

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.