From c72d3794ef4c010e1d844325e21bc474a116ff14 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 11:12:50 +0300 Subject: [PATCH 01/10] haskell-load: faces for overlay painting --- haskell-load.el | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/haskell-load.el b/haskell-load.el index 4ba8c4c43..5d645068e 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -265,6 +265,34 @@ actual Emacs buffer of the module being loaded." (modules (split-string modules-string ", "))) (cons modules modules-string))) +(defface haskell-error-face + '((((supports :underline (:style wave))) + :underline (:style wave :color "#dc322f")) + (t + :inherit error)) + "Face used for marking error lines." + :group 'haskell-mode) + +(defface haskell-warning-face + '((((supports :underline (:style wave))) + :underline (:style wave :color "#b58900")) + (t + :inherit warning)) + "Face used for marking warning lines." + :group 'haskell-mode) + +(defface haskell-hole-face + '((((supports :underline (:style wave))) + :underline (:style wave :color "#6c71c4")) + (t + :inherit warning)) + "Face used for marking hole lines." + :group 'haskell-mode) + +(defvar haskell-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark))) +(defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark))) +(defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar))) + (defun haskell-process-errors-warnings (module-buffer session process buffer &optional return-only) "Trigger handling type errors or warnings. Either prints the messages in the interactive buffer or if CONT is specified, From 8697e23ffa99596dee1e190048666ebe668462b4 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 11:13:37 +0300 Subject: [PATCH 02/10] haskell-load: haskell-check-paint-overlay, steal from ghc-mod --- haskell-load.el | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/haskell-load.el b/haskell-load.el index 5d645068e..aa3dc7d38 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -293,10 +293,43 @@ actual Emacs buffer of the module being loaded." (defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark))) (defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar))) +(defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file err hole coln) + (with-current-buffer buffer + (let (beg end) + (goto-char (point-min)) + ;; XXX: we can avoid excess buffer walking by relying on the maybe-fact that + ;; GHC sorts error messages by line number, maybe. + (cond + (error-from-this-file-p + (forward-line (1- line)) + (forward-char (1- coln)) + (setq beg (point)) + (if hole + (forward-char (length hole)) + (skip-chars-forward "^[:space:]" (line-end-position))) + (setq end (point))) + (t + (setq beg (point)) + (forward-line) + (setq end (point)))) + (let ((ovl (make-overlay beg end))) + (overlay-put ovl 'haskell-check t) + (overlay-put ovl 'haskell-file file) + (overlay-put ovl 'haskell-msg msg) + (overlay-put ovl 'help-echo msg) + (overlay-put ovl 'haskell-hole hole) + (cl-destructuring-bind (face fringe) (cond (err (list 'haskell-error-face haskell-check-error-fringe)) + (hole (list 'haskell-hole-face haskell-check-hole-fringe)) + (t (list 'haskell-warning-face haskell-check-warning-fringe))) + (overlay-put ovl 'before-string fringe) + (overlay-put ovl 'face face)))))) + (defun haskell-process-errors-warnings (module-buffer session process buffer &optional return-only) "Trigger handling type errors or warnings. Either prints the messages in the interactive buffer or if CONT is specified, -passes the error onto that." +passes the error onto that. + +When MODULE-BUFFER is non-NIL, paint error overlays." (cond ((haskell-process-consume process From d6dd2bffeb1f0f6abe81d1a32ad0c62fd0c18cc5 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Fri, 24 Jul 2015 00:36:04 +0300 Subject: [PATCH 03/10] haskell-load | haskell-process-errors-warnings: overlay painting --- haskell-load.el | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/haskell-load.el b/haskell-load.el index aa3dc7d38..9d9165326 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -92,6 +92,7 @@ actual Emacs buffer of the module being loaded." (cursor (haskell-process-response-cursor process)) (warning-count 0)) (haskell-process-set-response-cursor process 0) + (haskell-check-remove-overlays module-buffer) (while (haskell-process-errors-warnings module-buffer session process buffer) (setq warning-count (1+ warning-count))) (haskell-process-set-response-cursor process cursor) @@ -293,6 +294,10 @@ actual Emacs buffer of the module being loaded." (defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark))) (defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar))) +(defun haskell-check-remove-overlays (buffer) + (with-current-buffer buffer + (remove-overlays (point-min) (point-max) 'haskell-check t))) + (defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file err hole coln) (with-current-buffer buffer (let (beg end) @@ -363,20 +368,24 @@ When MODULE-BUFFER is non-NIL, paint error overlays." (- (haskell-process-response-cursor process) 1)) (let* ((buffer (haskell-process-response process)) (file (match-string 1 buffer)) - (location (match-string 2 buffer)) + (location-raw (match-string 2 buffer)) (error-msg (match-string 3 buffer)) (warning (string-match "^Warning:" error-msg)) (splice (string-match "^Splicing " error-msg)) + (errorp (not warning)) + ;; XXX: extract hole information, pass down to `haskell-check-paint-overlay' (final-msg (format "%s:%s: %s" (haskell-session-strip-dir session file) - location - error-msg))) + location-raw + error-msg)) + (location (haskell-process-parse-error (concat file ":" location-raw ": x"))) + (line (plist-get location :line)) + (col1 (plist-get location :col))) + (when module-buffer + (haskell-check-paint-overlay module-buffer (string= (file-truename (buffer-file-name module-buffer)) (file-truename file)) + line error-msg file errorp nil col1)) (if return-only - (let* ((location (haskell-process-parse-error (concat file ":" location ": x"))) - (file (plist-get location :file)) - (line (plist-get location :line)) - (col1 (plist-get location :col))) - (list :file file :line line :col col1 :msg error-msg :type (if warning 'warning 'error))) + (list :file file :line line :col col1 :msg error-msg :type (if warning 'warning 'error)) (progn (funcall (cond (warning 'haskell-interactive-mode-compile-warning) (splice From 59518ffdc6d416b388c92a94d2f05f72f29c738c Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 12:46:13 +0300 Subject: [PATCH 04/10] haskell-goto-{prev,next}-error: implement --- haskell-load.el | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/haskell-load.el b/haskell-load.el index 9d9165326..002afa146 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -294,10 +294,51 @@ actual Emacs buffer of the module being loaded." (defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark))) (defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar))) +(defun haskell-check-overlay-p (ovl) + (overlay-get ovl 'haskell-check)) + +(defun haskell-check-filter-overlays (xs) + (cl-remove-if-not 'haskell-check-overlay-p xs)) + (defun haskell-check-remove-overlays (buffer) (with-current-buffer buffer (remove-overlays (point-min) (point-max) 'haskell-check t))) +(defun overlay-start> (o1 o2) + (> (overlay-start o1) (overlay-start o2))) +(defun overlay-start< (o1 o2) + (< (overlay-start o1) (overlay-start o2))) + +(defun first-overlay-in-if (test beg end) + (let ((ovls (cl-remove-if-not test (overlays-in beg end)))) + (cl-first (sort (cl-copy-list ovls) 'overlay-start<)))) + +(defun last-overlay-in-if (test beg end) + (let ((ovls (cl-remove-if-not test (overlays-in beg end)))) + (cl-first (sort (cl-copy-list ovls) 'overlay-start>)))) + +(defun haskell-goto-error-overlay (ovl) + (cond (ovl + (goto-char (overlay-start ovl))) + (t + (message "No further notes from Haskell compiler.")))) + +(defun haskell-goto-prev-error () + (interactive) + (haskell-goto-error-overlay + (let ((ovl-at (cl-first (haskell-check-filter-overlays (overlays-at (point)))))) + (or (last-overlay-in-if 'haskell-check-overlay-p + (point-min) (if ovl-at (overlay-start ovl-at) (point))) + ovl-at)))) + +(defun haskell-goto-next-error () + (interactive) + (haskell-goto-error-overlay + (let ((ovl-at (cl-first (haskell-check-filter-overlays (overlays-at (point)))))) + (or (first-overlay-in-if 'haskell-check-overlay-p + (if ovl-at (overlay-end ovl-at) (point)) (point-max)) + ovl-at)))) + (defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file err hole coln) (with-current-buffer buffer (let (beg end) From 68427cab2e8b414553292c0743623b26df58fb0e Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 13:02:09 +0300 Subject: [PATCH 05/10] keybindings | haskell-mode: use M-n / M-p for error/warning overlay navigation --- doc/haskell-mode.texi | 2 ++ haskell.el | 2 ++ 2 files changed, 4 insertions(+) diff --git a/doc/haskell-mode.texi b/doc/haskell-mode.texi index 34078e7f0..30d0af3bb 100644 --- a/doc/haskell-mode.texi +++ b/doc/haskell-mode.texi @@ -536,6 +536,8 @@ Separate sessions per Cabal project @file{haskell-session.el}. A new inferior Haskell process handling code @file{haskell-process.el}. @item New REPL implementation similiar to SLIME/IELM +@item +Navigatable error overlays @file{haskell-interactive-mode.el}. @end itemize diff --git a/haskell.el b/haskell.el index eaa92b68e..706683853 100644 --- a/haskell.el +++ b/haskell.el @@ -49,6 +49,8 @@ (define-key map (kbd "C-c C-x") 'haskell-process-cabal) (define-key map [?\C-c ?\C-b] 'haskell-interactive-switch) (define-key map [?\C-c ?\C-z] 'haskell-interactive-switch) + (define-key map (kbd "M-n") 'haskell-goto-next-error) + (define-key map (kbd "M-p") 'haskell-goto-prev-error) map) "Keymap for using haskell-interactive-mode.") From ecc358f581c43d8df4f252eaf307d913daa17fd9 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 18:01:19 +0300 Subject: [PATCH 06/10] overlays: refactor message type handling a little --- haskell-load.el | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/haskell-load.el b/haskell-load.el index 002afa146..777fd4bce 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -339,7 +339,7 @@ actual Emacs buffer of the module being loaded." (if ovl-at (overlay-end ovl-at) (point)) (point-max)) ovl-at)))) -(defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file err hole coln) +(defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file type hole coln) (with-current-buffer buffer (let (beg end) (goto-char (point-min)) @@ -350,7 +350,7 @@ actual Emacs buffer of the module being loaded." (forward-line (1- line)) (forward-char (1- coln)) (setq beg (point)) - (if hole + (if (eq type 'hole) (forward-char (length hole)) (skip-chars-forward "^[:space:]" (line-end-position))) (setq end (point))) @@ -364,9 +364,10 @@ actual Emacs buffer of the module being loaded." (overlay-put ovl 'haskell-msg msg) (overlay-put ovl 'help-echo msg) (overlay-put ovl 'haskell-hole hole) - (cl-destructuring-bind (face fringe) (cond (err (list 'haskell-error-face haskell-check-error-fringe)) - (hole (list 'haskell-hole-face haskell-check-hole-fringe)) - (t (list 'haskell-warning-face haskell-check-warning-fringe))) + (cl-destructuring-bind (face fringe) (cl-case type + (warning (list 'haskell-warning-face haskell-check-warning-fringe)) + (hole (list 'haskell-hole-face haskell-check-hole-fringe)) + (error (list 'haskell-error-face haskell-check-error-fringe))) (overlay-put ovl 'before-string fringe) (overlay-put ovl 'face face)))))) @@ -411,9 +412,10 @@ When MODULE-BUFFER is non-NIL, paint error overlays." (file (match-string 1 buffer)) (location-raw (match-string 2 buffer)) (error-msg (match-string 3 buffer)) - (warning (string-match "^Warning:" error-msg)) - (splice (string-match "^Splicing " error-msg)) - (errorp (not warning)) + (type (cond ((string-match "^Warning:" error-msg) 'warning) + ((string-match "^Splicing " error-msg) 'splice) + (t 'error))) + (critical (not (eq type 'warning))) ;; XXX: extract hole information, pass down to `haskell-check-paint-overlay' (final-msg (format "%s:%s: %s" (haskell-session-strip-dir session file) @@ -424,16 +426,15 @@ When MODULE-BUFFER is non-NIL, paint error overlays." (col1 (plist-get location :col))) (when module-buffer (haskell-check-paint-overlay module-buffer (string= (file-truename (buffer-file-name module-buffer)) (file-truename file)) - line error-msg file errorp nil col1)) + line error-msg file type nil col1)) (if return-only - (list :file file :line line :col col1 :msg error-msg :type (if warning 'warning 'error)) - (progn (funcall (cond (warning - 'haskell-interactive-mode-compile-warning) - (splice - 'haskell-interactive-mode-compile-splice) - (t 'haskell-interactive-mode-compile-error)) + (list :file file :line line :col col1 :msg error-msg :type type) + (progn (funcall (cl-case type + (warning 'haskell-interactive-mode-compile-warning) + (splice 'haskell-interactive-mode-compile-splice) + (error 'haskell-interactive-mode-compile-error)) session final-msg) - (unless warning + (when critical (haskell-mode-message-line final-msg)) (haskell-process-trigger-suggestions session From e6834357805582f566d7ee11d9be434c8dacc7c0 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Sat, 18 Jul 2015 18:06:50 +0300 Subject: [PATCH 07/10] overlays: put a brief overlay summary into the modeline --- haskell-load.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/haskell-load.el b/haskell-load.el index 777fd4bce..370e01b83 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -317,9 +317,19 @@ actual Emacs buffer of the module being loaded." (let ((ovls (cl-remove-if-not test (overlays-in beg end)))) (cl-first (sort (cl-copy-list ovls) 'overlay-start>)))) +(defun haskell-error-overlay-briefly (ovl) + (let ((text (overlay-get ovl 'haskell-msg)) + (type (overlay-get ovl 'haskell-msg-type))) + (cond ((not (eq type 'warning)) + text) + ((string-prefix-p "Warning:\n " text) + (cl-subseq text 13)) + (t (error "Invariant failed: a warning message from GHC has unexpected form: %s." text))))) + (defun haskell-goto-error-overlay (ovl) (cond (ovl - (goto-char (overlay-start ovl))) + (goto-char (overlay-start ovl)) + (haskell-mode-message-line (haskell-error-overlay-briefly ovl))) (t (message "No further notes from Haskell compiler.")))) @@ -362,6 +372,7 @@ actual Emacs buffer of the module being loaded." (overlay-put ovl 'haskell-check t) (overlay-put ovl 'haskell-file file) (overlay-put ovl 'haskell-msg msg) + (overlay-put ovl 'haskell-msg-type type) (overlay-put ovl 'help-echo msg) (overlay-put ovl 'haskell-hole hole) (cl-destructuring-bind (face fringe) (cl-case type From f84845a163875f6ee9837fb7062b11a0c6b3eaa3 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Wed, 22 Jul 2015 10:42:52 +0300 Subject: [PATCH 08/10] haskell-process-error-warnings: fix docstring --- haskell-load.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell-load.el b/haskell-load.el index 370e01b83..b2d599b68 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -383,7 +383,7 @@ actual Emacs buffer of the module being loaded." (overlay-put ovl 'face face)))))) (defun haskell-process-errors-warnings (module-buffer session process buffer &optional return-only) - "Trigger handling type errors or warnings. Either prints the + "Trigger handling type errors or warnings. Either prints the messages in the interactive buffer or if CONT is specified, passes the error onto that. From e75d6e35f949bb1303fd777bec3d93dee8cdd6a2 Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Fri, 24 Jul 2015 01:00:04 +0300 Subject: [PATCH 09/10] haskell-load: with-overlay-properties --- haskell-load.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/haskell-load.el b/haskell-load.el index b2d599b68..6d5bd85ab 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -304,6 +304,14 @@ actual Emacs buffer of the module being loaded." (with-current-buffer buffer (remove-overlays (point-min) (point-max) 'haskell-check t))) +(defmacro with-overlay-properties (proplist ovl &rest body) + "Evaluate BODY with names in PROPLIST bound to the values of +correspondingly-named overlay properties of OVL." + (let ((ovlvar (cl-gensym "OVL-"))) + `(let* ((,ovlvar ,ovl) + ,@(mapcar (lambda (p) `(,p (overlay-get ,ovlvar ',p))) proplist)) + ,@body))) + (defun overlay-start> (o1 o2) (> (overlay-start o1) (overlay-start o2))) (defun overlay-start< (o1 o2) From bfab941f2661bfaa40f2f50745e4c4cdfbb2a4ee Mon Sep 17 00:00:00 2001 From: Kosyrev Serge <_deepfire@feelingofgreen.ru> Date: Fri, 24 Jul 2015 01:07:19 +0300 Subject: [PATCH 10/10] haskell-error-overlay-briefly: employ WITH-OVERLAY-PROPERTIES --- haskell-load.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/haskell-load.el b/haskell-load.el index 6d5bd85ab..7454f4419 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -326,13 +326,12 @@ correspondingly-named overlay properties of OVL." (cl-first (sort (cl-copy-list ovls) 'overlay-start>)))) (defun haskell-error-overlay-briefly (ovl) - (let ((text (overlay-get ovl 'haskell-msg)) - (type (overlay-get ovl 'haskell-msg-type))) - (cond ((not (eq type 'warning)) - text) - ((string-prefix-p "Warning:\n " text) - (cl-subseq text 13)) - (t (error "Invariant failed: a warning message from GHC has unexpected form: %s." text))))) + (with-overlay-properties (haskell-msg haskell-msg-type) ovl + (cond ((not (eq haskell-msg-type 'warning)) + haskell-msg) + ((string-prefix-p "Warning:\n " haskell-msg) + (cl-subseq haskell-msg 13)) + (t (error "Invariant failed: a warning message from GHC has unexpected form: %s." haskell-msg))))) (defun haskell-goto-error-overlay (ovl) (cond (ovl