Move catchSrcErrors over to GHC.Error

This commit is contained in:
Neil Mitchell 2019-09-11 22:31:59 +01:00
parent 18ee98f069
commit 37689a808e
2 changed files with 17 additions and 13 deletions

View File

@ -32,7 +32,6 @@ import Lexer
import ErrUtils
import qualified GHC
import Panic
import GhcMonad
import GhcPlugins as GHC hiding (fst3, (<>))
import qualified HeaderInfo as Hdr
@ -344,15 +343,3 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
let opts = Hdr.getOptions dflags0 contents fp
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
return dflags
-- | Run something in a Ghc monad and catch the errors (SourceErrors and
-- compiler-internal exceptions like Panic or InstallationError).
catchSrcErrors :: GhcMonad m => T.Text -> m a -> m (Either [FileDiagnostic] a)
catchSrcErrors fromWhere ghcM = do
dflags <- getDynFlags
handleGhcException (ghcExceptionToDiagnostics dflags) $
handleSourceError (sourceErrorToDiagnostics dflags) $
Right <$> ghcM
where
ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags
sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags . srcErrorMessages

View File

@ -8,6 +8,7 @@ module Development.IDE.GHC.Error
, diagFromString
, diagFromStrings
, diagFromGhcException
, catchSrcErrors
-- * utilities working with spans
, srcSpanToLocation
@ -23,6 +24,9 @@ import Development.IDE.GHC.Orphans()
import qualified FastString as FS
import GHC
import Bag
import DynFlags
import HscTypes
import Panic
import ErrUtils
import SrcLoc
import qualified Outputable as Out
@ -111,6 +115,19 @@ realSpan = \case
UnhelpfulSpan _ -> Nothing
-- | Run something in a Ghc monad and catch the errors (SourceErrors and
-- compiler-internal exceptions like Panic or InstallationError).
catchSrcErrors :: GhcMonad m => T.Text -> m a -> m (Either [FileDiagnostic] a)
catchSrcErrors fromWhere ghcM = do
dflags <- getDynFlags
handleGhcException (ghcExceptionToDiagnostics dflags) $
handleSourceError (sourceErrorToDiagnostics dflags) $
Right <$> ghcM
where
ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags
sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags . srcErrorMessages
diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
diagFromGhcException diagSource dflags exc = diagFromString diagSource (noSpan "<Internal>") (showGHCE dflags exc)