first try to resolve #322.

This commit is contained in:
Kazu Yamamoto 2014-08-18 16:55:41 +09:00
parent f799ff1ee8
commit 0fd8b9afd8
3 changed files with 19 additions and 17 deletions

View File

@ -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
----------------------------------------------------------------

View File

@ -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

View File

@ -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)))))