From 0fd8b9afd82ad94d0245fedcea72a3eb0c30790a Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 18 Aug 2014 16:55:41 +0900
Subject: [PATCH] first try to resolve #322.

---
 Language/Haskell/GhcMod/Check.hs | 18 ++++--------------
 Language/Haskell/GhcMod/Monad.hs |  6 +++---
 elisp/ghc-check.el               | 12 ++++++++++++
 3 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs
index 8e7a1a5..3d20e51 100644
--- a/Language/Haskell/GhcMod/Check.hs
+++ b/Language/Haskell/GhcMod/Check.hs
@@ -21,13 +21,8 @@ import Language.Haskell.GhcMod.Target (setTargetFiles)
 checkSyntax :: IOish m
             => [FilePath]  -- ^ The target files.
             -> GhcModT m String
-checkSyntax [] = return ""
-checkSyntax files = withErrorHandler sessionName $
-    either id id <$> check files
-  where
-    sessionName = case files of
-      [file] -> file
-      _      -> "MultipleFiles"
+checkSyntax []    = return ""
+checkSyntax files = withErrorHandler $ either id id <$> check files
 
 ----------------------------------------------------------------
 
@@ -51,13 +46,8 @@ check fileNames = overrideGhcUserOptions $ \ghcOpts -> do
 expandTemplate :: IOish m
                => [FilePath]  -- ^ The target files.
                -> GhcModT m String
-expandTemplate [] = return ""
-expandTemplate files = withErrorHandler sessionName $
-    either id id <$> expand files
-  where
-    sessionName = case files of
-      [file] -> file
-      _      -> "MultipleFiles"
+expandTemplate []    = return ""
+expandTemplate files = withErrorHandler $ either id id <$> expand files
 
 ----------------------------------------------------------------
 
diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs
index a46e2f1..5eaefef 100644
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@@ -273,13 +273,13 @@ runGhcModT' r s a = do
   return (res, w')
 ----------------------------------------------------------------
 
-withErrorHandler :: IOish m => String -> GhcModT m a -> GhcModT m a
-withErrorHandler label = ghandle ignore
+withErrorHandler :: IOish m => GhcModT m a -> GhcModT m a
+withErrorHandler = ghandle ignore
   where
     ignore :: IOish m => SomeException -> GhcModT m a
     ignore e = liftIO $ do
-        hPutStr stderr $ label ++ ":0:0:Error:"
         hPrint stderr e
+        -- FIXME: should print NG
         exitSuccess
 
 -- | Make a copy of the 'gmGhcSession' IORef, run the action and restore the
diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el
index 5d6bd8c..8cf9282 100644
--- a/elisp/ghc-check.el
+++ b/elisp/ghc-check.el
@@ -110,6 +110,18 @@ nil            does not display errors/warnings.
 	      (setq mode-line-process (format " %d:%d" elen wlen)))))
 	(force-mode-line-update))))
    (t
+    (let* ((err (buffer-substring-no-properties (point-min) (point)))
+	   (info (ghc-make-hilit-info
+		  :file "Fail errors:"
+		  :line 0
+		  :coln 0
+		  :msg  err
+		  :err  t
+		  :hole nil))
+	   (infos (list info))
+	   (file ghc-process-original-file)
+	   (buf ghc-process-original-buffer))
+      (ghc-check-highlight-original-buffer file buf infos))
     (ghc-with-current-buffer ghc-process-original-buffer
       (setq mode-line-process " failed")
       (force-mode-line-update)))))