M-t inserts inferred type!

Check.hs

@@ -18,17 +18,23 @@ checkSyntax opt file = do
     (_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file,"-outputdir","dist/flymake","-o","dist/flymake/a.out"] Nothing Nothing
     refine <$> hGetContents herr
   where
-   refine = unfoldLines start . map (dropWhile isSpace) . filter (/="") . lines
-   start = (file `isPrefixOf`)
+    refine = unfoldLines . map shrinkSpaces . remove . lines
+    remove = filter (\x -> not ("Linking" `isPrefixOf` x))
+           . filter (\x -> not ("[" `isPrefixOf` x))
+           . filter (/="")
+    shrinkSpaces x
+      | isSpace (head x) = ' ' : dropWhile isSpace x
+      | otherwise        = x
 
-unfoldLines :: (String -> Bool) -> [String] -> String
-unfoldLines _ [] = ""
-unfoldLines p (x:xs) = x ++ unfold xs
+unfoldLines :: [String] -> String
+unfoldLines [] = ""
+unfoldLines (x:xs) = x ++ unfold xs
   where
     unfold [] = "\n"
     unfold (l:ls)
-      | p l       = ('\n':l) ++ unfold ls
-      | otherwise = (' ' :l) ++ unfold ls
+      | isAlpha (head l)           = ('\n':l) ++ unfold ls
+      | " Inferred" `isPrefixOf` l = "." ++ l ++ unfold ls
+      | otherwise                  = l ++ unfold ls
 
 ----------------------------------------------------------------
 

elisp/ghc-flymake.el

@@ -29,4 +29,20 @@
     (list ghc-module-command (append (ghc-module-command-args)
 				     (list "check" file)))))
 
+(defun ghc-flymake-insert-type ()
+  (interactive)
+  (let ((data (ghc-flymake-data)))
+    (if (and data
+	     (string-match "Inferred type: \\([^:]+ :: \\)\\(forall [^.]+\\. \\)?\\(.*\\)" data))
+      (progn
+	(beginning-of-line)
+	(insert (match-string 1 data) (match-string 3 data) "\n"))
+      (message "No inferred type"))))
+
+(defun ghc-flymake-data ()
+  (let* ((line-no (flymake-current-line-no))
+         (line-err-info-list (nth 0 (flymake-find-err-info flymake-err-info line-no)))
+         (menu-data (flymake-make-err-menu-data line-no line-err-info-list)))
+    (nth 0 (nth 0 (nth 1 menu-data)))))
+
 (provide 'ghc-flymake)

elisp/ghc.el

@@ -36,6 +36,7 @@
 (defvar ghc-previous-key    "\ep")
 (defvar ghc-next-key        "\en")
 (defvar ghc-help-key        "\e?")
+(defvar ghc-insert-type-key "\et")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -52,6 +53,7 @@
     (define-key haskell-mode-map ghc-previous-key    'flymake-goto-prev-error)
     (define-key haskell-mode-map ghc-next-key        'flymake-goto-next-error)
     (define-key haskell-mode-map ghc-help-key        'flymake-display-err-menu-for-current-line)
+    (define-key haskell-mode-map ghc-insert-type-key 'ghc-flymake-insert-type)
     (ghc-comp-init)
     (setq ghc-initialized t)))