diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 1dc0c0f2a2..43cb1803cc 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -213,38 +213,41 @@ getParsedModuleRule = opt <- getIdeOptions modify_dflags <- getModifyDynFlags dynFlagsModifyParser let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } - - let dflags = ms_hspp_opts ms - mainParse = getParsedModuleDefinition hsc opt file ms reset_ms pm = pm { pm_mod_summary = ms' } - -- Parse again (if necessary) to capture Haddock parse errors - res@(_,pmod) <- if gopt Opt_Haddock dflags - then - liftIO $ (fmap.fmap.fmap) reset_ms mainParse - else do - let haddockParse = getParsedModuleDefinition hsc opt file (withOptHaddock ms) - - -- parse twice, with and without Haddocks, concurrently - -- we cannot ignore Haddock parse errors because files of - -- non-interest are always parsed with Haddocks - -- If we can parse Haddocks, might as well use them - -- - -- HLINT INTEGRATION: might need to save the other parsed module too - ((diags,res),(diagsh,resh)) <- liftIO $ (fmap.fmap.fmap.fmap) reset_ms $ concurrently mainParse haddockParse - - -- Merge haddock and regular diagnostics so we can always report haddock - -- parse errors - let diagsM = mergeParseErrorsHaddock diags diagsh - case resh of - Just _ - | HaddockParse <- optHaddockParse opt - -> pure (diagsM, resh) - -- If we fail to parse haddocks, report the haddock diagnostics as well and - -- return the non-haddock parse. - -- This seems to be the correct behaviour because the Haddock flag is added - -- by us and not the user, so our IDE shouldn't stop working because of it. - _ -> pure (diagsM, res) + -- We still parse with Haddocks whether Opt_Haddock is True or False to collect information + -- but we no longer need to parse with and without Haddocks separately for above GHC90. + res@(_,pmod) <- if Compat.ghcVersion >= Compat.GHC90 then + liftIO $ (fmap.fmap.fmap) reset_ms $ getParsedModuleDefinition hsc opt file (withOptHaddock ms) + else do + let dflags = ms_hspp_opts ms + mainParse = getParsedModuleDefinition hsc opt file ms + + -- Parse again (if necessary) to capture Haddock parse errors + if gopt Opt_Haddock dflags + then + liftIO $ (fmap.fmap.fmap) reset_ms mainParse + else do + let haddockParse = getParsedModuleDefinition hsc opt file (withOptHaddock ms) + + -- parse twice, with and without Haddocks, concurrently + -- we cannot ignore Haddock parse errors because files of + -- non-interest are always parsed with Haddocks + -- If we can parse Haddocks, might as well use them + ((diags,res),(diagsh,resh)) <- liftIO $ (fmap.fmap.fmap.fmap) reset_ms $ concurrently mainParse haddockParse + + -- Merge haddock and regular diagnostics so we can always report haddock + -- parse errors + let diagsM = mergeParseErrorsHaddock diags diagsh + case resh of + Just _ + | HaddockParse <- optHaddockParse opt + -> pure (diagsM, resh) + -- If we fail to parse haddocks, report the haddock diagnostics as well and + -- return the non-haddock parse. + -- This seems to be the correct behaviour because the Haddock flag is added + -- by us and not the user, so our IDE shouldn't stop working because of it. + _ -> pure (diagsM, res) -- Add dependencies on included files _ <- uses GetModificationTime $ map toNormalizedFilePath' (maybe [] pm_extra_src_files pmod) pure res @@ -896,9 +899,11 @@ regenerateHiFile sess f ms compNeeded = do -- Embed haddocks in the interface file (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) - (diags, mb_pm) <- case mb_pm of - Just _ -> return (diags, mb_pm) - Nothing -> do + (diags, mb_pm) <- + -- We no longer need to parse again if GHC version is above 9.0. https://github.com/haskell/haskell-language-server/issues/1892 + if Compat.ghcVersion >= Compat.GHC90 || isJust mb_pm then do + return (diags, mb_pm) + else do -- if parsing fails, try parsing again with Haddock turned off (diagsNoHaddock, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm)