hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
elisp/ghc-check.el
View File

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

7
elisp/ghc-command.el
View File

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