error messages are stored after NG, not printed in stderr.

This commit is contained in:
Kazu Yamamoto 2014-08-19 14:56:01 +09:00
parent e696a66dfa
commit a483f4f8b6
3 changed files with 15 additions and 5 deletions

View File

@ -1,14 +1,13 @@
module Language.Haskell.GhcMod.Utils where module Language.Haskell.GhcMod.Utils where
import MonadUtils (MonadIO, liftIO)
import Control.Exception import Control.Exception
import Control.Monad.Error (MonadError(..), Error(..)) import Control.Monad.Error (MonadError(..), Error(..))
import MonadUtils (MonadIO, liftIO)
import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Process (readProcessWithExitCode)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import System.IO (hPutStrLn, stderr)
import System.IO.Error (tryIOError) import System.IO.Error (tryIOError)
import System.Process (readProcessWithExitCode)
-- dropWhileEnd is not provided prior to base 4.5.0.0. -- dropWhileEnd is not provided prior to base 4.5.0.0.
dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@ -34,9 +33,9 @@ readProcess' cmd opts = do
(rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts "" (rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""
case rv of case rv of
ExitFailure val -> do ExitFailure val -> do
liftIO $ hPutStrLn stderr err
throwError $ strMsg $ throwError $ strMsg $
cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")" cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
++ "\n" ++ err
ExitSuccess -> ExitSuccess ->
return output return output

View File

@ -110,7 +110,7 @@ nil does not display errors/warnings.
(setq mode-line-process (format " %d:%d" elen wlen))))) (setq mode-line-process (format " %d:%d" elen wlen)))))
(force-mode-line-update)))) (force-mode-line-update))))
(t (t
(let* ((err (buffer-substring-no-properties (point-min) (point))) (let* ((err (ghc-unescape-string (buffer-substring-no-properties (+ (point) 3) (point-max))))
(info (ghc-make-hilit-info (info (ghc-make-hilit-info
:file "Fail errors:" :file "Fail errors:"
:line 0 :line 0

View File

@ -32,6 +32,17 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-unescape-string (str)
(with-temp-buffer
(insert str)
(goto-char (point-min))
(while (search-forward "\\n" nil t) (replace-match "\n" nil t))
(goto-char (point-min))
(while (search-forward "\\\\" nil t) (replace-match "\\" nil t))
(buffer-substring-no-properties (point-min) (point-max))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro ghc-add (sym val) (defmacro ghc-add (sym val)
`(setq ,sym (cons ,val ,sym))) `(setq ,sym (cons ,val ,sym)))