Add haskell-mode-find-uses command

Makefile

@@ -9,6 +9,7 @@ SUBST_ATAT = sed -e 's/@@GIT_VERSION@@/$(GIT_VERSION)/g;s/@GIT_VERSION@/$(GIT_VE
 
 ELFILES = \
 	ghc-core.el \
+	highlight-uses-mode.el \
 	haskell-align-imports.el \
 	haskell-bot.el \
 	haskell-cabal.el \

haskell-commands.el

@@ -22,6 +22,7 @@
 (require 'haskell-font-lock)
 (require 'haskell-interactive-mode)
 (require 'haskell-session)
+(require 'highlight-uses-mode)
 
 (defun haskell-process-restart ()
   "Restart the inferior Haskell process."
@@ -365,11 +366,16 @@ command from GHCi."
   (interactive)
   (let ((loc (haskell-mode-loc-at)))
     (when loc
-      (find-file (expand-file-name (plist-get loc :path)
-                                   (haskell-session-cabal-dir (haskell-interactive-session))))
-      (goto-char (point-min))
-      (forward-line (1- (plist-get loc :start-line)))
-      (forward-char (plist-get loc :start-col)))))
+      (haskell-mode-goto-span loc))))
+
+(defun haskell-mode-goto-span (span)
+  "Jump to the span, whatever file and line and column it needs
+to to get there."
+  (find-file (expand-file-name (plist-get span :path)
+                               (haskell-session-cabal-dir (haskell-interactive-session))))
+  (goto-char (point-min))
+  (forward-line (1- (plist-get span :start-line)))
+  (forward-char (plist-get span :start-col)))
 
 (defun haskell-process-insert-type ()
   "Get the identifer at the point and insert its type, if
@@ -752,4 +758,73 @@ remains unchanged."
     (delete-file tmp-file)
     (delete-file err-file)))
 
+(defun haskell-mode-find-uses ()
+  "Find uses of the identifier at point, highlight them all."
+  (interactive)
+  (let ((spans (haskell-mode-uses-at)))
+    (unless (null spans)
+      (highlight-uses-mode 1)
+      (cl-loop for span in spans
+               do (haskell-mode-make-use-highlight span)))))
+
+(defun haskell-mode-make-use-highlight (span)
+  "Make a highlight overlay at the given span."
+  (save-window-excursion
+    (save-excursion
+      (haskell-mode-goto-span span)
+      (save-excursion
+        (highlight-uses-mode-highlight
+         (progn
+           (goto-char (point-min))
+           (forward-line (1- (plist-get span :start-line)))
+           (forward-char (plist-get span :start-col))
+           (point))
+         (progn
+           (goto-char (point-min))
+           (forward-line (1- (plist-get span :end-line)))
+           (forward-char (plist-get span :end-col))
+           (point)))))))
+
+(defun haskell-mode-uses-at ()
+  "Get the locations of uses for the ident at point. Requires
+the :uses command from GHCi."
+  (let ((pos (or (when (region-active-p)
+                   (cons (region-beginning)
+                         (region-end)))
+                 (haskell-ident-pos-at-point)
+                 (cons (point)
+                       (point)))))
+    (when pos
+      (let ((reply (haskell-process-queue-sync-request
+                    (haskell-interactive-process)
+                    (save-excursion
+                      (format ":uses %s %d %d %d %d %s"
+                              (buffer-file-name)
+                              (progn (goto-char (car pos))
+                                     (line-number-at-pos))
+                              (1+ (current-column)) ;; GHC uses 1-based columns.
+                              (progn (goto-char (cdr pos))
+                                     (line-number-at-pos))
+                              (1+ (current-column)) ;; GHC uses 1-based columns.
+                              (buffer-substring-no-properties (car pos)
+                                                              (cdr pos)))))))
+        (if reply
+            (let ((lines (split-string reply "\n" t)))
+              (cl-remove-if
+               #'null
+               (mapcar (lambda (line)
+                         (if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
+                                           line)
+                             (list :path (match-string 1 line)
+                                   :start-line (string-to-number (match-string 2 line))
+                                   ;; ;; GHC uses 1-based columns.
+                                   :start-col (1- (string-to-number (match-string 3 line)))
+                                   :end-line (string-to-number (match-string 4 line))
+                                   ;; GHC uses 1-based columns.
+                                   :end-col (1- (string-to-number (match-string 5 line))))
+                           (error (propertize line 'face 'compilation-error))))
+                       lines)))
+          (error (propertize "No reply. Is :uses supported?"
+                             'face 'compilation-error)))))))
+
 (provide 'haskell-commands)

highlight-uses-mode.el

@@ -0,0 +1,65 @@
+;;; highlight-uses-mode.el --- Mode for highlighting uses
+
+;; Copyright (c) 2014 Chris Done. All rights reserved.
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(defvar highlight-uses-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "TAB") 'highlight-uses-mode-next)
+    (define-key map (kbd "S-TAB") 'highlight-uses-mode-prev)
+    (define-key map (kbd "<backtab>") 'highlight-uses-mode-prev)
+    (define-key map (kbd "C-g") 'highlight-uses-mode)
+    map)
+  "Keymap for using haskell-interactive-mode.")
+
+;;;###autoload
+(define-minor-mode highlight-uses-mode
+  "Minor mode for highlighting and jumping between uses."
+  :lighter " Uses"
+  :keymap highlight-uses-mode-map
+  (remove-overlays (point-min) (point-max) 'highlight-uses-mode-highlight t))
+
+(defun highlight-uses-mode-next ()
+  "Jump to next result."
+  (interactive)
+  (let ((os (overlays-in (point) (point-max))))
+    (let ((last-point (point)))
+      (while (car os)
+        (goto-char (overlay-start (car os)))
+        (if (= (point) last-point)
+            (setq os (cdr os))
+          (setq os nil))))))
+
+(defun highlight-uses-mode-prev ()
+  "Jump to previous result."
+  (interactive)
+  (let ((os (overlays-in (point-min) (point))))
+    (let ((last-point (point)))
+      (while (car os)
+        (goto-char (overlay-start (car os)))
+        (if (= (point) last-point)
+            (setq os (cdr os))
+          (setq os nil))))))
+
+(defun highlight-uses-mode-highlight (start end)
+  "Make a highlight overlay at the given span."
+  (let ((o (make-overlay start end)))
+    (overlay-put o 'priority 999)
+    (overlay-put o 'face 'isearch-lazy-highlight)
+    (overlay-put o 'highlight-uses-mode-highlight t)))
+
+(provide 'highlight-uses-mode)