git.iko.soy/ghcide
on master help sign in
A couple of improvements to the experience developing hie-core itself (#2812)

* Put information about the compiler pass in the _source field of Diagnostic It's useful when looking at the hie-core command-line output to see where a problem is coming from. * include test code in hie-core's own cradle

commit52b745ce31bfe67efe0bc432a8d59764cfb620c8 authorGanesh Sittampalam <ganesh@earth.li> dateSun 8 Sep 2019, 18:04 (7 years ago) parent42461d1
5 files changed+36−32
compare with master
unifiedsplit
hie.yaml+3 src/Development/IDE/Core/Compile.hs+14−14 src/Development/IDE/GHC/Error.hs+14−14 src/Development/IDE/GHC/Warnings.hs+4−3 src/Development/IDE/Import/FindImports.hs+1−1
hie.yaml+3
@@ -23,3 +23,6 @@ cradle:
2323 - -DGHC_STABLE
2424 - -isrc
2525 - -iexe
26+ - -itest/cabal
27+ - -itest/src
28+ - -itest/exe
src/Development/IDE/Core/Compile.hs+14−14
@@ -90,9 +90,9 @@ typecheckModule
9090typecheckModule packageState deps pm =
9191 fmap (either (, Nothing) (second Just)) $
9292 runGhcEnv packageState $
93− catchSrcErrors $ do
93+ catchSrcErrors "typecheck" $ do
9494 setupEnv deps
95− (warnings, tcm) <- withWarnings $ \tweak ->
95+ (warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
9696 GHC.typecheckModule pm{pm_mod_summary = tweak $ pm_mod_summary pm}
9797 tcm2 <- mkTcModuleResult tcm
9898 return (warnings, tcm2)
@@ -107,12 +107,12 @@ compileModule
107107compileModule packageState deps tmr =
108108 fmap (either (, Nothing) (second Just)) $
109109 runGhcEnv packageState $
110− catchSrcErrors $ do
110+ catchSrcErrors "compile" $ do
111111 setupEnv (deps ++ [tmr])
112112
113113 let tm = tmrModule tmr
114114 session <- getSession
115− (warnings,desugar) <- withWarnings $ \tweak -> do
115+ (warnings,desugar) <- withWarnings "compile" $ \tweak -> do
116116 let pm = tm_parsed_module tm
117117 let pm' = pm{pm_mod_summary = tweak $ pm_mod_summary pm}
118118 let tm' = tm{tm_parsed_module = pm'}
@@ -199,7 +199,7 @@ getImportsParsed dflags (L loc parsed) = do
199199 let srcImports = filter (ideclSource . GHC.unLoc) $ GHC.hsmodImports parsed
200200 when (not $ null srcImports) $ Left $
201201 concat
202− [ diagFromString mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
202+ [ diagFromString "imports" mloc ("Illegal source import of " <> GHC.moduleNameString (GHC.unLoc $ GHC.ideclName i))
203203 | L mloc i <- srcImports ]
204204
205205 -- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
@@ -322,7 +322,7 @@ parseFileContents preprocessor filename mbContents = do
322322
323323 case unP Parser.parseModule (mkPState dflags contents loc) of
324324 PFailed _ locErr msgErr ->
325− throwE $ diagFromErrMsg dflags $ mkPlainErrMsg dflags locErr msgErr
325+ throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
326326 POk pst rdr_module ->
327327 let hpm_annotations =
328328 (Map.fromListWith (++) $ annotations pst,
@@ -341,11 +341,11 @@ parseFileContents preprocessor filename mbContents = do
341341 -- errors are those from which a parse tree just can't
342342 -- be produced.
343343 unless (null errs) $
344− throwE $ diagFromErrMsgs dflags $ snd $ getMessages pst dflags
344+ throwE $ diagFromErrMsgs "parser" dflags $ snd $ getMessages pst dflags
345345
346346 -- Ok, we got here. It's safe to continue.
347347 let (errs, parsed) = preprocessor rdr_module
348− unless (null errs) $ throwE $ diagFromStrings errs
348+ unless (null errs) $ throwE $ diagFromStrings "parser" errs
349349 ms <- getModSummaryFromBuffer filename contents dflags parsed
350350 let pm =
351351 ParsedModule {
@@ -354,7 +354,7 @@ parseFileContents preprocessor filename mbContents = do
354354 , pm_extra_src_files=[] -- src imports not allowed
355355 , pm_annotations = hpm_annotations
356356 }
357− warnings = diagFromErrMsgs dflags warns
357+ warnings = diagFromErrMsgs "parser" dflags warns
358358 pure (warnings, pm)
359359
360360
@@ -364,7 +364,7 @@ parsePragmasIntoDynFlags
364364 => FilePath
365365 -> SB.StringBuffer
366366 -> m (Either [FileDiagnostic] DynFlags)
367−parsePragmasIntoDynFlags fp contents = catchSrcErrors $ do
367+parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
368368 dflags0 <- getSessionDynFlags
369369 let opts = Hdr.getOptions dflags0 contents fp
370370 (dflags, _, _) <- parseDynamicFilePragma dflags0 opts
@@ -372,12 +372,12 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors $ do
372372
373373-- | Run something in a Ghc monad and catch the errors (SourceErrors and
374374-- compiler-internal exceptions like Panic or InstallationError).
375−catchSrcErrors :: GhcMonad m => m a -> m (Either [FileDiagnostic] a)
376−catchSrcErrors ghcM = do
375+catchSrcErrors :: GhcMonad m => T.Text -> m a -> m (Either [FileDiagnostic] a)
376+catchSrcErrors fromWhere ghcM = do
377377 dflags <- getDynFlags
378378 handleGhcException (ghcExceptionToDiagnostics dflags) $
379379 handleSourceError (sourceErrorToDiagnostics dflags) $
380380 Right <$> ghcM
381381 where
382− ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException dflags
383− sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs dflags . srcErrorMessages
382+ ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags
383+ sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags . srcErrorMessages
src/Development/IDE/GHC/Error.hs+14−14
@@ -29,26 +29,26 @@ import qualified Outputable as Out
2929
3030
3131
32−diagFromText :: D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
33−diagFromText sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
32+diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
33+diagFromText diagSource sev loc msg = (toNormalizedFilePath $ srcSpanToFilename loc,)
3434 Diagnostic
3535 { _range = srcSpanToRange loc
3636 , _severity = Just sev
37− , _source = Just "compiler" -- should really be 'daml' or 'haskell', but not shown in the IDE so who cares
37+ , _source = Just diagSource -- not shown in the IDE, but useful for hie-core developers
3838 , _message = msg
3939 , _code = Nothing
4040 , _relatedInformation = Nothing
4141 }
4242
4343-- | Produce a GHC-style error from a source span and a message.
44−diagFromErrMsg :: DynFlags -> ErrMsg -> [FileDiagnostic]
45−diagFromErrMsg dflags e =
46− [ diagFromText sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
44+diagFromErrMsg :: T.Text -> DynFlags -> ErrMsg -> [FileDiagnostic]
45+diagFromErrMsg diagSource dflags e =
46+ [ diagFromText diagSource sev (errMsgSpan e) $ T.pack $ Out.showSDoc dflags $ ErrUtils.pprLocErrMsg e
4747 | Just sev <- [toDSeverity $ errMsgSeverity e]]
4848
4949
50−diagFromErrMsgs :: DynFlags -> Bag ErrMsg -> [FileDiagnostic]
51−diagFromErrMsgs dflags = concatMap (diagFromErrMsg dflags) . bagToList
50+diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
51+diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList
5252
5353
5454-- | Convert a GHC SrcSpan to a DAML compiler Range
@@ -86,12 +86,12 @@ toDSeverity SevFatal = Just DsError
8686
8787-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
8888-- (optional) locations and message strings.
89−diagFromStrings :: [(SrcSpan, String)] -> [FileDiagnostic]
90−diagFromStrings = concatMap (uncurry diagFromString)
89+diagFromStrings :: T.Text -> [(SrcSpan, String)] -> [FileDiagnostic]
90+diagFromStrings diagSource = concatMap (uncurry (diagFromString diagSource))
9191
9292-- | Produce a GHC-style error from a source span and a message.
93−diagFromString :: SrcSpan -> String -> [FileDiagnostic]
94−diagFromString sp x = [diagFromText DsError sp $ T.pack x]
93+diagFromString :: T.Text -> SrcSpan -> String -> [FileDiagnostic]
94+diagFromString diagSource sp x = [diagFromText diagSource DsError sp $ T.pack x]
9595
9696
9797-- | Produces an "unhelpful" source span with the given string.
@@ -111,8 +111,8 @@ realSpan = \case
111111 UnhelpfulSpan _ -> Nothing
112112
113113
114−diagFromGhcException :: DynFlags -> GhcException -> [FileDiagnostic]
115−diagFromGhcException dflags exc = diagFromString (noSpan "<Internal>") (showGHCE dflags exc)
114+diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
115+diagFromGhcException diagSource dflags exc = diagFromString diagSource (noSpan "<Internal>") (showGHCE dflags exc)
116116
117117showGHCE :: DynFlags -> GhcException -> String
118118showGHCE dflags exc = case exc of
src/Development/IDE/GHC/Warnings.hs+4−3
@@ -9,6 +9,7 @@ import GhcPlugins as GHC hiding (Var)
99
1010import Control.Concurrent.Extra
1111import Control.Monad.Extra
12+import qualified Data.Text as T
1213
1314import Development.IDE.Types.Diagnostics
1415import Development.IDE.GHC.Util
@@ -24,12 +25,12 @@ import Development.IDE.GHC.Error
2425-- https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640
2526-- which basically says that log_action is taken from the ModSummary when GHC feels like it.
2627-- The given argument lets you refresh a ModSummary log_action
27−withWarnings :: GhcMonad m => ((ModSummary -> ModSummary) -> m a) -> m ([FileDiagnostic], a)
28−withWarnings action = do
28+withWarnings :: GhcMonad m => T.Text -> ((ModSummary -> ModSummary) -> m a) -> m ([FileDiagnostic], a)
29+withWarnings diagSource action = do
2930 warnings <- liftIO $ newVar []
3031 oldFlags <- getDynFlags
3132 let newAction dynFlags _ _ loc _ msg = do
32− let d = diagFromErrMsg dynFlags $ mkPlainWarnMsg dynFlags loc msg
33+ let d = diagFromErrMsg diagSource dynFlags $ mkPlainWarnMsg dynFlags loc msg
3334 modifyVar_ warnings $ return . (d:)
3435 setLogAction newAction
3536 res <- action $ \x -> x{ms_hspp_opts = (ms_hspp_opts x){log_action = newAction}}
src/Development/IDE/Import/FindImports.hs+1−1
@@ -80,7 +80,7 @@ notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnost
8080notFoundErr dfs modName reason =
8181 mkError' $ ppr' $ cannotFindModule dfs modName0 $ lookupToFindResult reason
8282 where
83− mkError' = diagFromString (getLoc modName)
83+ mkError' = diagFromString "not found" (getLoc modName)
8484 modName0 = unLoc modName
8585 ppr' = showSDoc dfs
8686 -- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer.