making case-split work even if the target is highlighted.

This commit is contained in:
Kazu Yamamoto 2014-08-20 14:44:24 +09:00
parent 51710c38b0
commit 607919e815
2 changed files with 50 additions and 48 deletions

View File

@ -366,51 +366,52 @@ nil does not display errors/warnings.
(defun ghc-check-insert-from-warning ()
(interactive)
(dolist (data (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) (ghc-check-overlay-at (point))))
(save-excursion
(cond
((string-match "Inferred type: \\|no type signature:" data)
(beginning-of-line)
(insert-before-markers (ghc-extract-type data) "\n"))
((string-match "lacks an accompanying binding" data)
(beginning-of-line)
(when (looking-at "^\\([^ ]+\\) *::")
(save-match-data
(forward-line)
(if (not (bolp)) (insert "\n")))
(insert (match-string 1) " = undefined\n")))
;; GHC 7.8 uses Unicode for single-quotes.
((string-match "Not in scope: type constructor or class .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(ghc-ins-mod sym)))
((string-match "Not in scope: data constructor .\\([^\n]+\\)." data)
;; if the type of data constructor, it would be nice.
(let ((sym (match-string 1 data)))
(ghc-ins-mod sym)))
((string-match "\n[ ]+.\\([^ ]+\\). is a data constructor of .\\([^\n]+\\).\n" data)
(let* ((old (match-string 1 data))
(type-const (match-string 2 data))
(new (format "%s(%s)" type-const old)))
(ghc-check-replace old new)))
((string-match "Not in scope: .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(if (or (string-match "\\." sym) ;; qualified
(y-or-n-p (format "Import module for %s?" sym)))
(ghc-ins-mod sym)
(unless (re-search-forward "^$" nil t)
(goto-char (point-max))
(insert "\n"))
(insert "\n" (ghc-enclose sym) " = undefined\n"))))
((string-match "Pattern match(es) are non-exhaustive" data)
(let* ((fn (ghc-get-function-name))
(arity (ghc-get-function-arity fn)))
(ghc-insert-underscore fn arity)))
((string-match "Found:\n[ ]+\\([^\t]+\\)\nWhy not:\n[ ]+\\([^\t]+\\)" data)
(let ((old (match-string 1 data))
(new (match-string 2 data)))
(ghc-check-replace old new)))
(t
(message "Nothing was done"))))))
(let ((ret t))
(dolist (data (mapcar (lambda (ovl) (overlay-get ovl 'ghc-msg)) (ghc-check-overlay-at (point))) ret)
(save-excursion
(cond
((string-match "Inferred type: \\|no type signature:" data)
(beginning-of-line)
(insert-before-markers (ghc-extract-type data) "\n"))
((string-match "lacks an accompanying binding" data)
(beginning-of-line)
(when (looking-at "^\\([^ ]+\\) *::")
(save-match-data
(forward-line)
(if (not (bolp)) (insert "\n")))
(insert (match-string 1) " = undefined\n")))
;; GHC 7.8 uses Unicode for single-quotes.
((string-match "Not in scope: type constructor or class .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(ghc-ins-mod sym)))
((string-match "Not in scope: data constructor .\\([^\n]+\\)." data)
;; if the type of data constructor, it would be nice.
(let ((sym (match-string 1 data)))
(ghc-ins-mod sym)))
((string-match "\n[ ]+.\\([^ ]+\\). is a data constructor of .\\([^\n]+\\).\n" data)
(let* ((old (match-string 1 data))
(type-const (match-string 2 data))
(new (format "%s(%s)" type-const old)))
(ghc-check-replace old new)))
((string-match "Not in scope: .\\([^\n]+\\)." data)
(let ((sym (match-string 1 data)))
(if (or (string-match "\\." sym) ;; qualified
(y-or-n-p (format "Import module for %s?" sym)))
(ghc-ins-mod sym)
(unless (re-search-forward "^$" nil t)
(goto-char (point-max))
(insert "\n"))
(insert "\n" (ghc-enclose sym) " = undefined\n"))))
((string-match "Pattern match(es) are non-exhaustive" data)
(let* ((fn (ghc-get-function-name))
(arity (ghc-get-function-arity fn)))
(ghc-insert-underscore fn arity)))
((string-match "Found:\n[ ]+\\([^\t]+\\)\nWhy not:\n[ ]+\\([^\t]+\\)" data)
(let ((old (match-string 1 data))
(new (match-string 2 data)))
(ghc-check-replace old new)))
(t
(setq ret nil)))))))
(defun ghc-check-replace (old new)
(beginning-of-line)

View File

@ -17,10 +17,11 @@
((bobp)
(ghc-insert-module-template))
((ghc-check-overlay-at (point))
(ghc-check-insert-from-warning))
(or (ghc-check-insert-from-warning)
(ghc-try-case-split)))
(t
(when (null (ghc-try-case-split))
(message "Nothing to be done")))))
(unless (ghc-try-case-split)
(message "Nothing to be done")))))
(defun ghc-insert-module-template ()
(let* ((fullname (file-name-sans-extension (buffer-file-name)))