hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

catch parse errors.

Browse Source
This commit is contained in:
Kazu Yamamoto 2010-05-04 19:31:14 +09:00
parent fde44468a6
commit ae89d284ad
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Check.hs
View File

@ -5,12 +5,14 @@ import Control.Applicative
import Data.IORef import Data.IORef
import DynFlags import DynFlags
import ErrUtils import ErrUtils
import Exception
import FastString import FastString
import GHC import GHC
import HscTypes import HscTypes
import Outputable hiding (showSDoc) import Outputable hiding (showSDoc)
import Pretty import Pretty
import Types import Types
import Prelude hiding (catch)
---------------------------------------------------------------- ----------------------------------------------------------------
@ -24,7 +26,8 @@ check fileName = withGHC $ do
ref <- liftIO $ newIORef [] ref <- liftIO $ newIORef []
initSession initSession
setTargetFile fileName setTargetFile fileName
loadWithLogger (refLogger ref) LoadAllTargets loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
clearWarnings
liftIO $ readIORef ref liftIO $ readIORef ref
where where
-- I don't know why, but parseDynamicFlags must be used. -- I don't know why, but parseDynamicFlags must be used.
@ -35,6 +38,9 @@ check fileName = withGHC $ do
setTargetFile file = do setTargetFile file = do
target <- guessTarget file Nothing target <- guessTarget file Nothing
setTargets [target] setTargets [target]
handleParseError ref e = do
liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
return Succeeded
-- I don't know why, but parseDynamicFlags must be used. -- I don't know why, but parseDynamicFlags must be used.
cmdOptions :: [Located String] cmdOptions :: [Located String]
@ -43,14 +49,13 @@ cmdOptions = map noLoc ["-Wall","-fno-warn-unused-do-bind"]
---------------------------------------------------------------- ----------------------------------------------------------------
refLogger :: IORef [String] -> WarnErrLogger refLogger :: IORef [String] -> WarnErrLogger
refLogger ref Nothing = do refLogger ref Nothing =
warns <- map showErrMsg . reverse . bagToList <$> getWarnings (errBagToStrList <$> getWarnings) >>= liftIO . writeIORef ref
liftIO $ writeIORef ref warns refLogger ref (Just e) =
clearWarnings liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
refLogger ref (Just e) = do
let errs = map showErrMsg . reverse . bagToList . srcErrorMessages $ e errBagToStrList :: Bag ErrMsg -> [String]
liftIO $ writeIORef ref errs errBagToStrList = map showErrMsg . reverse . bagToList
clearWarnings
---------------------------------------------------------------- ----------------------------------------------------------------