From ccb9980436da32e82c2e5a2f8d80a769dd74bce7 Mon Sep 17 00:00:00 2001
From: Alejandro Serrano <trupill@gmail.com>
Date: Sun, 27 Jul 2014 11:19:16 +0200
Subject: [PATCH] Display only hole information when navigating it

---
 elisp/ghc-check.el | 44 ++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 40 insertions(+), 4 deletions(-)

diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el
index 1903509..59928fb 100644
--- a/elisp/ghc-check.el
+++ b/elisp/ghc-check.el
@@ -216,6 +216,42 @@ nil            does not display errors/warnings.
             (message "%s" errmsg)
           (message "%s\n\n%s" file errmsg))))))
 
+(defun ghc-get-only-holes ()
+  (let ((ovls (ghc-check-overlay-at (point))))
+    (when ovls
+      (let ((msgs (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) ovls))
+	    (file (overlay-get (car ovls) 'ghc-file))
+	    holes)
+	(dolist (msg msgs)
+	  (if (string-match "Found hole" msg)
+	      (ghc-add holes msg)
+	      nil))
+	(ghc-make-file-msgs :file file :msgs holes)))))
+
+(defun ghc-display-holes ()
+  (interactive)
+  (let ((file-msgs (ghc-get-only-holes)))
+    (if (null file-msgs)
+	(message "No holes")
+      (let ((file (ghc-file-msgs-get-file file-msgs))
+	    (msgs (ghc-file-msgs-get-msgs file-msgs)))
+	(ghc-display
+	 nil
+	 (lambda ()
+	   (mapc (lambda (x) (insert x "\n\n")) msgs)))))))
+
+(defun ghc-display-holes-to-minibuf ()
+  (let ((file-msgs (ghc-get-only-holes)))
+    (if (null file-msgs)
+	(message "No errors or warnings")
+      (let* ((file (ghc-file-msgs-get-file file-msgs))
+	     (msgs (ghc-file-msgs-get-msgs file-msgs))
+	     (errmsg (mapconcat 'identity msgs "\n"))
+	     (buffile buffer-file-name))
+        (if (string-equal buffile file)
+            (message "%s" errmsg)
+          (message "%s\n\n%s" file errmsg))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun ghc-goto-prev-error ()
@@ -255,8 +291,8 @@ nil            does not display errors/warnings.
          (pnts (mapcar 'overlay-start ovls3)))
     (if pnts (goto-char (apply 'max pnts))))
   (cond
-   ((eq ghc-display-hole 'minibuffer) (ghc-display-errors-to-minibuf))
-   ((eq ghc-display-hole 'other-buffer) (ghc-display-errors))))
+   ((eq ghc-display-hole 'minibuffer) (ghc-display-holes-to-minibuf))
+   ((eq ghc-display-hole 'other-buffer) (ghc-display-holes))))
 
 (defun ghc-goto-next-hole ()
   (interactive)
@@ -269,8 +305,8 @@ nil            does not display errors/warnings.
          (pnts (mapcar 'overlay-start ovls3)))
     (if pnts (goto-char (apply 'min pnts))))
   (cond
-   ((eq ghc-display-hole 'minibuffer) (ghc-display-errors-to-minibuf))
-   ((eq ghc-display-hole 'other-buffer) (ghc-display-errors))))
+   ((eq ghc-display-hole 'minibuffer) (ghc-display-holes-to-minibuf))
+   ((eq ghc-display-hole 'other-buffer) (ghc-display-holes))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;