git.iko.soy/ghcide
on master help sign in
Allow preprocessors to emit warnings (#176)

* Allow to emit warnings in preprocessor * preprocessor result type IdePreprocessedSource

commit95201719218742b4c4729dfb7e290959c355ee44 authorAndreas Herrmann <andreash87@gmx.ch> dateMon 21 Oct 2019, 12:24 (7 years ago) parent58b997d
4 files changed+24−13
compare with master
unifiedsplit
src/Development/IDE/Core/Compile.hs+5−4 src/Development/IDE/GHC/Error.hs+5−5 src/Development/IDE/Import/FindImports.hs+1−1 src/Development/IDE/Types/Options.hs+13−3
src/Development/IDE/Core/Compile.hs+5−4
@@ -309,7 +309,7 @@ getModSummaryFromBuffer fp contents dflags parsed = do
309309-- parsed module (or errors) and any parse warnings.
310310parseFileContents
311311 :: GhcMonad m
312− => (GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource))
312+ => (GHC.ParsedSource -> IdePreprocessedSource)
313313 -> FilePath -- ^ the filename (for source locations)
314314 -> Maybe SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
315315 -> ExceptT [FileDiagnostic] m ([FileDiagnostic], ParsedModule)
@@ -340,8 +340,9 @@ parseFileContents customPreprocessor filename mbContents = do
340340 throwE $ diagFromErrMsgs "parser" dflags $ snd $ getMessages pst dflags
341341
342342 -- Ok, we got here. It's safe to continue.
343− let (errs, parsed) = customPreprocessor rdr_module
344− unless (null errs) $ throwE $ diagFromStrings "parser" errs
343+ let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module
344+ unless (null errs) $ throwE $ diagFromStrings "parser" DsError errs
345+ let preproc_warnings = diagFromStrings "parser" DsWarning preproc_warns
345346 ms <- getModSummaryFromBuffer filename contents dflags parsed
346347 let pm =
347348 ParsedModule {
@@ -351,4 +352,4 @@ parseFileContents customPreprocessor filename mbContents = do
351352 , pm_annotations = hpm_annotations
352353 }
353354 warnings = diagFromErrMsgs "parser" dflags warns
354− pure (warnings, pm)
355+ pure (warnings ++ preproc_warnings, pm)
src/Development/IDE/GHC/Error.hs+5−5
@@ -90,12 +90,12 @@ toDSeverity SevFatal = Just DsError
9090
9191-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
9292-- (optional) locations and message strings.
93−diagFromStrings :: T.Text -> [(SrcSpan, String)] -> [FileDiagnostic]
94−diagFromStrings diagSource = concatMap (uncurry (diagFromString diagSource))
93+diagFromStrings :: T.Text -> D.DiagnosticSeverity -> [(SrcSpan, String)] -> [FileDiagnostic]
94+diagFromStrings diagSource sev = concatMap (uncurry (diagFromString diagSource sev))
9595
9696-- | Produce a GHC-style error from a source span and a message.
97−diagFromString :: T.Text -> SrcSpan -> String -> [FileDiagnostic]
98−diagFromString diagSource sp x = [diagFromText diagSource DsError sp $ T.pack x]
97+diagFromString :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> String -> [FileDiagnostic]
98+diagFromString diagSource sev sp x = [diagFromText diagSource sev sp $ T.pack x]
9999
100100
101101-- | Produces an "unhelpful" source span with the given string.
@@ -129,7 +129,7 @@ catchSrcErrors fromWhere ghcM = do
129129
130130
131131diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic]
132−diagFromGhcException diagSource dflags exc = diagFromString diagSource (noSpan "<Internal>") (showGHCE dflags exc)
132+diagFromGhcException diagSource dflags exc = diagFromString diagSource DsError (noSpan "<Internal>") (showGHCE dflags exc)
133133
134134showGHCE :: DynFlags -> GhcException -> String
135135showGHCE dflags exc = case exc of
src/Development/IDE/Import/FindImports.hs+1−1
@@ -95,7 +95,7 @@ notFoundErr :: DynFlags -> Located M.ModuleName -> LookupResult -> [FileDiagnost
9595notFoundErr dfs modName reason =
9696 mkError' $ ppr' $ cannotFindModule dfs modName0 $ lookupToFindResult reason
9797 where
98− mkError' = diagFromString "not found" (getLoc modName)
98+ mkError' = diagFromString "not found" DsError (getLoc modName)
9999 modName0 = unLoc modName
100100 ppr' = showSDoc dfs
101101 -- We convert the lookup result to a find result to reuse GHC's cannotFindMoudle pretty printer.
src/Development/IDE/Types/Options.hs+13−3
@@ -6,6 +6,7 @@
66-- | Options
77module Development.IDE.Types.Options
88 ( IdeOptions(..)
9+ , IdePreprocessedSource(..)
910 , IdeReportProgress(..)
1011 , IdeDefer(..)
1112 , clientSupportsProgress
@@ -21,9 +22,9 @@ import GhcPlugins as GHC hiding (fst3, (<>))
2122import qualified Language.Haskell.LSP.Types.Capabilities as LSP
2223
2324data IdeOptions = IdeOptions
24− { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)
25+ { optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource
2526 -- ^ Preprocessor to run over all parsed source trees, generating a list of warnings
26− -- along with a new parse tree.
27+ -- and a list of errors, along with a new parse tree.
2728 , optGhcSession :: IO (FilePath -> Action HscEnvEq)
2829 -- ^ Setup a GHC session for a given file, e.g. @Foo.hs@.
2930 -- The 'IO' will be called once, then the resulting function will be applied once per file.
@@ -53,6 +54,15 @@ data IdeOptions = IdeOptions
5354 -- the presence of type errors, holes or unbound variables.
5455 }
5556
57+data IdePreprocessedSource = IdePreprocessedSource
58+ { preprocWarnings :: [(GHC.SrcSpan, String)]
59+ -- ^ Warnings emitted by the preprocessor.
60+ , preprocErrors :: [(GHC.SrcSpan, String)]
61+ -- ^ Errors emitted by the preprocessor.
62+ , preprocSource :: GHC.ParsedSource
63+ -- ^ New parse tree emitted by the preprocessor.
64+ }
65+
5666newtype IdeReportProgress = IdeReportProgress Bool
5767newtype IdeDefer = IdeDefer Bool
5868
@@ -62,7 +72,7 @@ clientSupportsProgress caps = IdeReportProgress $ fromMaybe False $
6272
6373defaultIdeOptions :: IO (FilePath -> Action HscEnvEq) -> IdeOptions
6474defaultIdeOptions session = IdeOptions
65− {optPreprocessor = (,) []
75+ {optPreprocessor = IdePreprocessedSource [] []
6676 ,optGhcSession = session
6777 ,optExtensions = ["hs", "lhs"]
6878 ,optPkgLocationOpts = defaultIdePkgLocationOptions