diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 978e0ceccb..419d5b95e5 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -172,11 +172,11 @@ typecheckModule :: IdeDefer typecheckModule (IdeDefer defer) hsc tc_helpers pm = do let modSummary = pm_mod_summary pm dflags = ms_hspp_opts modSummary - mmodSummary' <- catchSrcErrors (hsc_dflags hsc) "typecheck (initialize plugins)" + initialized <- catchSrcErrors (hsc_dflags hsc) "typecheck (initialize plugins)" (initPlugins hsc modSummary) - case mmodSummary' of + case initialized of Left errs -> return (errs, Nothing) - Right modSummary' -> do + Right (modSummary', hsc) -> do (warnings, etcm) <- withWarnings "typecheck" $ \tweak -> let session = tweak (hscSetFlags dflags hsc) @@ -569,11 +569,6 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do . (("Error during " ++ T.unpack source) ++) . show @SomeException ] -initPlugins :: HscEnv -> ModSummary -> IO ModSummary -initPlugins session modSummary = do - session1 <- liftIO $ initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session) - return modSummary{ms_hspp_opts = hsc_dflags session1} - -- | Whether we should run the -O0 simplifier when generating core. -- -- This is required for template Haskell to work but we disable this in DAML. @@ -1101,7 +1096,9 @@ getModSummaryFromImports -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult getModSummaryFromImports env fp modTime contents = do - (contents, opts, dflags) <- preprocessor env fp contents + (contents, opts, env) <- preprocessor env fp contents + + let dflags = hsc_dflags env -- The warns will hopefully be reported when we actually parse the module (_warns, L main_loc hsmod) <- parseHeader dflags fp contents diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index d41a7f9795..ef08264d7a 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -36,12 +36,12 @@ import GHC.Utils.Outputable (renderWithContext) -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. -preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], DynFlags) -preprocessor env0 filename mbContents = do +preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv) +preprocessor env filename mbContents = do -- Perform unlit (isOnDisk, contents) <- if isLiterate filename then do - newcontent <- liftIO $ runLhs env0 filename mbContents + newcontent <- liftIO $ runLhs env filename mbContents return (False, newcontent) else do contents <- liftIO $ maybe (Util.hGetStringBuffer filename) return mbContents @@ -49,17 +49,17 @@ preprocessor env0 filename mbContents = do return (isOnDisk, contents) -- Perform cpp - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env0 filename contents - let env1 = hscSetFlags dflags env0 - let logger = hsc_logger env1 - (isOnDisk, contents, opts, dflags) <- + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + let dflags = hsc_dflags env + let logger = hsc_logger env + (isOnDisk, contents, opts, env) <- if not $ xopt LangExt.Cpp dflags then - return (isOnDisk, contents, opts, dflags) + return (isOnDisk, contents, opts, env) else do cppLogs <- liftIO $ newIORef [] let newLogger = pushLogHook (const (logActionCompat $ logAction cppLogs)) logger contents <- ExceptT - $ (Right <$> (runCpp (putLogHook newLogger env1) filename + $ (Right <$> (runCpp (putLogHook newLogger env) filename $ if isOnDisk then Nothing else Just contents)) `catch` ( \(e :: Util.GhcException) -> do @@ -68,16 +68,16 @@ preprocessor env0 filename mbContents = do [] -> throw e diags -> return $ Left diags ) - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents - return (False, contents, opts, dflags) + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + return (False, contents, opts, env) -- Perform preprocessor if not $ gopt Opt_Pp dflags then - return (contents, opts, dflags) + return (contents, opts, env) else do - contents <- liftIO $ runPreprocessor env1 filename $ if isOnDisk then Nothing else Just contents - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents - return (contents, opts, dflags) + contents <- liftIO $ runPreprocessor env filename $ if isOnDisk then Nothing else Just contents + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + return (contents, opts, env) where logAction :: IORef [CPPLog] -> LogActionCompat logAction cppLogs dflags _reason severity srcSpan _style msg = do @@ -137,12 +137,12 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"] -- | This reads the pragma information directly from the provided buffer. -parsePragmasIntoDynFlags +parsePragmasIntoHscEnv :: HscEnv -> FilePath -> Util.StringBuffer - -> IO (Either [FileDiagnostic] ([String], DynFlags)) -parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do + -> IO (Either [FileDiagnostic] ([String], HscEnv)) +parsePragmasIntoHscEnv env fp contents = catchSrcErrors dflags0 "pragmas" $ do #if MIN_VERSION_ghc(9,3,0) let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp #else @@ -154,7 +154,7 @@ parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do (dflags, _, _) <- parseDynamicFilePragma dflags0 opts hsc_env' <- initializePlugins (hscSetFlags dflags env) - return (map unLoc opts, disableWarningsAsErrors (hsc_dflags hsc_env')) + return (map unLoc opts, hscSetFlags (disableWarningsAsErrors $ hsc_dflags hsc_env') hsc_env') where dflags0 = hsc_dflags env -- | Run (unlit) literate haskell preprocessor on a file, or buffer if set diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 83a8e9bad8..87831f8723 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -255,7 +255,7 @@ getParsedModuleRule recorder = define (cmapWithPrio LogShake recorder) $ \GetParsedModule file -> do ModSummaryResult{msrModSummary = ms'} <- use_ GetModSummary file sess <- use_ GhcSession file - let hsc = hscEnv sess + (ms', hsc) <- liftIO $ initPlugins (hscEnv sess) ms' opt <- getIdeOptions modify_dflags <- getModifyDynFlags dynFlagsModifyParser let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } @@ -329,6 +329,7 @@ getParsedModuleWithCommentsRule recorder = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetParsedModuleWithComments file -> do ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary file sess <- use_ GhcSession file + (ms, hsc) <- liftIO $ initPlugins (hscEnv sess) ms opt <- getIdeOptions let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms @@ -336,7 +337,7 @@ getParsedModuleWithCommentsRule recorder = let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition (hscEnv sess) opt file ms + liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a getModifyDynFlags f = do diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 9af3d38162..dc91f63cb1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -7,6 +7,7 @@ module Development.IDE.GHC.Compat.Plugins ( PluginWithArgs(..), applyPluginsParsedResultAction, initializePlugins, + initPlugins, -- * Static plugins StaticPlugin(..), @@ -67,6 +68,12 @@ initializePlugins env = do pure $ hscSetFlags newDf env #endif +-- Plugins aren't stored in ModSummary anymore since GHC 9.0, but this +-- function still returns it for compatibility with 8.10 +initPlugins :: HscEnv -> ModSummary -> IO (ModSummary, HscEnv) +initPlugins session modSummary = do + session1 <- initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session) + return (modSummary{ms_hspp_opts = hsc_dflags session1}, session1) hsc_static_plugins :: HscEnv -> [StaticPlugin] #if MIN_VERSION_ghc(9,3,0)