From 24fa3d5f667753fa484c3aae41b7ba95472825a0 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 25 Jun 2021 15:53:32 -0700 Subject: [PATCH 1/4] wip config disabling --- ghcide/src/Development/IDE/Main.hs | 8 +++++--- ghcide/src/Development/IDE/Plugin.hs | 2 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 10 +++++++++- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 1003b32c6e..170f750728 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -91,6 +91,7 @@ import System.IO (BufferMode (LineBufferin import System.Time.Extra (offsetTime, showDuration) import Text.Printf (printf) +import Debug.Trace (traceM, trace) data Command = Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures @@ -218,6 +219,7 @@ defaultMain Arguments{..} = do sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir config <- LSP.runLspT env LSP.getConfig + traceM $ "config::: " <> show config let def_options = argsIdeOptions config sessionLoader -- disable runSubset if the client doesn't support watched files @@ -225,7 +227,7 @@ defaultMain Arguments{..} = do let options = def_options { optReportProgress = clientSupportsProgress caps - , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins + , optModifyDynFlags = optModifyDynFlags def_options <> trace "from LSP for real" (pluginModifyDynflags plugins config) , optRunSubset = runSubset } caps = LSP.resClientCapabilities env @@ -269,7 +271,7 @@ defaultMain Arguments{..} = do options = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False - , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins + , optModifyDynFlags = optModifyDynFlags def_options <> trace "not for real 2" (pluginModifyDynflags plugins def) } ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan shakeSessionInit ide @@ -319,7 +321,7 @@ defaultMain Arguments{..} = do options = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False - , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins + , optModifyDynFlags = optModifyDynFlags def_options <> trace "not for real" (pluginModifyDynflags plugins def) } ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan shakeSessionInit ide diff --git a/ghcide/src/Development/IDE/Plugin.hs b/ghcide/src/Development/IDE/Plugin.hs index 531df7b593..0e682d6c9f 100644 --- a/ghcide/src/Development/IDE/Plugin.hs +++ b/ghcide/src/Development/IDE/Plugin.hs @@ -10,7 +10,7 @@ import qualified Language.LSP.Server as LSP data Plugin c = Plugin {pluginRules :: Rules () ,pluginHandlers :: LSP.Handlers (ServerM c) - ,pluginModifyDynflags :: DynFlagsModifications + ,pluginModifyDynflags :: c -> DynFlagsModifications } instance Default (Plugin c) where diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index fbaf5ea936..0720be2ed9 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -39,6 +39,7 @@ import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) import UnliftIO.Async (forConcurrently) import UnliftIO.Exception (catchAny) +import Debug.Trace (trace) -- --------------------------------------------------------------------- -- @@ -70,7 +71,14 @@ rulesPlugins rs = mempty { P.pluginRules = rules } rules = foldMap snd rs dynFlagsPlugins :: [(PluginId, DynFlagsModifications)] -> Plugin Config -dynFlagsPlugins rs = mempty { P.pluginModifyDynflags = foldMap snd rs } +dynFlagsPlugins rs = mempty + { P.pluginModifyDynflags = + flip foldMap rs $ \(plId, dflag_mods) cfg -> + let plg_cfg = configForPlugin cfg plId + in case trace ("enabling dynflag mods for " <> show plId <> "? " <> show (plcGlobalOn plg_cfg)) $ plcGlobalOn plg_cfg of + True -> dflag_mods + False -> mempty + } -- --------------------------------------------------------------------- From 601056d2bbbaf37581d2eca7da96cf45492755e9 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 19 Jul 2021 13:04:26 -0700 Subject: [PATCH 2/4] Correctly disable dynflags when plugin is disabled --- ghcide/session-loader/Development/IDE/Session.hs | 4 +--- ghcide/src/Development/IDE/Core/Rules.hs | 5 ++++- ghcide/src/Development/IDE/Main.hs | 8 +++----- ghcide/src/Development/IDE/Types/Options.hs | 2 +- 4 files changed, 9 insertions(+), 10 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 7a88249823..b5a7ba893c 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -85,7 +85,6 @@ import Database.SQLite.Simple import HieDb.Create import HieDb.Types import HieDb.Utils -import Ide.Types (dynFlagsModifyGlobal) -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String @@ -283,8 +282,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do packageSetup (hieYaml, cfp, opts, libDir) = do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv ideNc libDir - (df, targets) <- evalGhcEnv hscEnv $ - first (dynFlagsModifyGlobal optModifyDynFlags) <$> setOptions opts (hsc_dflags hscEnv) + (df, targets) <- evalGhcEnv hscEnv $ setOptions opts (hsc_dflags hscEnv) let deps = componentDependencies opts ++ maybeToList hieYaml dep_info <- getDependencyInfo deps -- Now lookup to see whether we are combining with an existing HscEnv diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 949d326509..c4cbab0d02 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -292,7 +292,10 @@ getParsedModuleWithCommentsRule = liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition (hscEnv sess) opt file ms getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a -getModifyDynFlags f = f . optModifyDynFlags <$> getIdeOptions +getModifyDynFlags f = do + opts <- getIdeOptions + cfg <- getClientConfigAction def + pure $ f $ optModifyDynFlags opts cfg getParsedModuleDefinition diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 4856ce838a..700d2e21fb 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -101,7 +101,6 @@ import System.IO (BufferMode (LineBufferin import System.Time.Extra (offsetTime, showDuration) import Text.Printf (printf) -import Debug.Trace (traceM, trace) data Command = Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures @@ -247,7 +246,6 @@ defaultMain Arguments{..} = do sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir config <- LSP.runLspT env LSP.getConfig - traceM $ "config::: " <> show config let def_options = argsIdeOptions config sessionLoader -- disable runSubset if the client doesn't support watched files @@ -255,7 +253,7 @@ defaultMain Arguments{..} = do let options = def_options { optReportProgress = clientSupportsProgress caps - , optModifyDynFlags = optModifyDynFlags def_options <> trace "from LSP for real" (pluginModifyDynflags plugins config) + , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins , optRunSubset = runSubset } caps = LSP.resClientCapabilities env @@ -304,7 +302,7 @@ defaultMain Arguments{..} = do options = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False - , optModifyDynFlags = optModifyDynFlags def_options <> trace "not for real 2" (pluginModifyDynflags plugins def) + , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan shakeSessionInit ide @@ -355,7 +353,7 @@ defaultMain Arguments{..} = do options = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False - , optModifyDynFlags = optModifyDynFlags def_options <> trace "not for real" (pluginModifyDynflags plugins def) + , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan shakeSessionInit ide diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index 817481dfea..2968e54abf 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -72,7 +72,7 @@ data IdeOptions = IdeOptions -- Otherwise, return the result of parsing without Opt_Haddock, so -- that the parsed module contains the result of Opt_KeepRawTokenStream, -- which might be necessary for hlint. - , optModifyDynFlags :: DynFlagsModifications + , optModifyDynFlags :: Config -> DynFlagsModifications -- ^ Will be called right after setting up a new cradle, -- allowing to customize the Ghc options used , optShakeOptions :: ShakeOptions From dc265317265f383e4b3934df48a8fc827016dddb Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 19 Jul 2021 13:05:46 -0700 Subject: [PATCH 3/4] Remove trace --- ghcide/src/Development/IDE/Plugin/HLS.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 0720be2ed9..9df72fba9a 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -39,7 +39,6 @@ import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) import UnliftIO.Async (forConcurrently) import UnliftIO.Exception (catchAny) -import Debug.Trace (trace) -- --------------------------------------------------------------------- -- @@ -75,7 +74,7 @@ dynFlagsPlugins rs = mempty { P.pluginModifyDynflags = flip foldMap rs $ \(plId, dflag_mods) cfg -> let plg_cfg = configForPlugin cfg plId - in case trace ("enabling dynflag mods for " <> show plId <> "? " <> show (plcGlobalOn plg_cfg)) $ plcGlobalOn plg_cfg of + in case plcGlobalOn plg_cfg of True -> dflag_mods False -> mempty } From 84034d8eb4c6d5390a145024061d1e4ad79d2eb2 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 19 Jul 2021 13:37:06 -0700 Subject: [PATCH 4/4] Fuck hlint --- ghcide/src/Development/IDE/Plugin/HLS.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 9df72fba9a..842b69b530 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -74,9 +74,9 @@ dynFlagsPlugins rs = mempty { P.pluginModifyDynflags = flip foldMap rs $ \(plId, dflag_mods) cfg -> let plg_cfg = configForPlugin cfg plId - in case plcGlobalOn plg_cfg of - True -> dflag_mods - False -> mempty + in if plcGlobalOn plg_cfg + then dflag_mods + else mempty } -- ---------------------------------------------------------------------