From e875778b49e9508ff7f6d3ca2353e57522a2b66f Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 27 Feb 2012 11:01:18 +0900 Subject: [PATCH] M-t insert "foo _ _ = undefined" for non-exhaustive pattern. --- elisp/ghc-flymake.el | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/elisp/ghc-flymake.el b/elisp/ghc-flymake.el index 4b91d63..211d29c 100644 --- a/elisp/ghc-flymake.el +++ b/elisp/ghc-flymake.el @@ -114,6 +114,10 @@ (goto-char (point-max)) (insert "\n"))) (insert "\n" (match-string 1 data) " = 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:\0[ ]*\\([^\0]+\\)\0Why not:\0[ ]*\\([^\0]+\\)" data) (let ((old (match-string 1 data)) (new (match-string 2 data))) @@ -124,6 +128,39 @@ (delete-region (point) end)) (insert new)))))))) +(defun ghc-get-function-name () + (save-excursion + (beginning-of-line) + (when (looking-at "\\([^ ]+\\) ") + (match-string 1)))) + +(defun ghc-get-function-arity (fn) + (when fn + (save-excursion + (let ((regex (format "^%s *::" (regexp-quote fn)))) + (when (re-search-backward regex nil t) + (ghc-get-function-arity0)))))) + +(defun ghc-get-function-arity0 () + (let ((end (save-excursion (end-of-line) (point))) + (arity 0)) + (while (search-forward "->" end t) + (setq arity (1+ arity))) + arity)) + +(defun ghc-insert-underscore (fn ar) + (when fn + (let ((arity (or ar 1))) + (save-excursion + (goto-char (point-max)) + (re-search-backward (format "^%s *::" (regexp-quote fn))) + (forward-line) + (re-search-forward "^$" nil t) + (insert fn) + (dotimes (i arity) + (insert " _")) + (insert " = undefined\n"))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-flymake-err-get-title (x) (nth 0 x))