making case-split work even if the target is highlighted.
This commit is contained in:
parent
51710c38b0
commit
607919e815
@ -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)
|
||||
|
@ -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)))
|
||||
|
Loading…
Reference in New Issue
Block a user