From 178e58f7489a0ffd0d0893bac48991ac7efdff9c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 25 Nov 2021 06:03:09 +0000 Subject: [PATCH 1/5] configureCheckProject --- ghcide/test/exe/Main.hs | 7 ++----- ghcide/test/src/Development/IDE/Test.hs | 12 ++++++++++-- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 21f2939d5b..b61eeb32fb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -53,7 +53,7 @@ import Development.IDE.Test (Cursor, getInterfaceFilesDir, waitForAction, getStoredKeys, - waitForTypecheck, waitForGC) + waitForTypecheck, waitForGC, configureCheckProject) import Development.IDE.Test.Runfiles import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location @@ -1603,10 +1603,7 @@ extendImportTests = testGroup "extend import actions" codeActionTitle CodeAction{_title=x} = x template setUpModules moduleUnderTest range expectedTitles expectedContentB = do - sendNotification SWorkspaceDidChangeConfiguration - (DidChangeConfigurationParams $ toJSON - def{checkProject = overrideCheckProject}) - + configureCheckProject overrideCheckProject mapM_ (\x -> createDoc (fst x) "haskell" (snd x)) setUpModules docB <- createDoc (fst moduleUnderTest) "haskell" (snd moduleUnderTest) diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index cdabcdcd22..2e7e976b01 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -29,14 +29,16 @@ module Development.IDE.Test , getStoredKeys , waitForCustomMessage , waitForGC - ,getBuildKeysBuilt,getBuildKeysVisited,getBuildKeysChanged,getBuildEdgesCount) where + ,getBuildKeysBuilt,getBuildKeysVisited,getBuildKeysChanged,getBuildEdgesCount,configureCheckProject) where import Control.Applicative.Combinators import Control.Lens hiding (List) import Control.Monad import Control.Monad.IO.Class +import Data.Aeson (toJSON) import qualified Data.Aeson as A import Data.Bifunctor (second) +import Data.Default import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import Data.Text (Text) @@ -45,7 +47,7 @@ import Development.IDE.Plugin.Test (TestRequest (..), WaitForIdeRuleResult, ideResultSuccess) import Development.IDE.Test.Diagnostic -import Ide.Plugin.Config (CheckParents) +import Ide.Plugin.Config (CheckParents, checkProject) import Language.LSP.Test hiding (message) import qualified Language.LSP.Test as LspTest import Language.LSP.Types hiding @@ -246,3 +248,9 @@ waitForGC = waitForCustomMessage "ghcide/GC" $ \v -> case A.fromJSON v of A.Success x -> Just x _ -> Nothing + +configureCheckProject :: Bool -> Session () +configureCheckProject overrideCheckProject = + sendNotification SWorkspaceDidChangeConfiguration + (DidChangeConfigurationParams $ toJSON + def{checkProject = overrideCheckProject}) From 8dfb998c283df7f879105cfecd5589cf1d7da329 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 25 Nov 2021 06:04:02 +0000 Subject: [PATCH 2/5] disable checkProject in the ghcide test suite --- ghcide/ghcide.cabal | 1 + ghcide/test/exe/Main.hs | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index b1d84ecf9f..5ae04274c3 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -442,6 +442,7 @@ executable ghcide-bench base, bytestring, containers, + data-default, directory, extra, filepath, diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index b61eeb32fb..f85105af35 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5816,7 +5816,9 @@ runInDir' dir startExeIn startSessionIn extraOptions s = do -- Only sets HOME if it wasn't already set. setEnv "HOME" "/homeless-shelter" False conf <- getConfigFromEnv - runSessionWithConfig conf cmd lspTestCaps projDir s + runSessionWithConfig conf cmd lspTestCaps projDir $ do + configureCheckProject False + s getConfigFromEnv :: IO SessionConfig getConfigFromEnv = do From 45eacd5fa3d1d686f9178adbd0c562ca44a4c257 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 26 Nov 2021 13:27:04 +0000 Subject: [PATCH 3/5] Fix getOptions to honor LSP config overrides This is a bit ugly, but we already do it in defaultMain I also realized I don't really understand the HLS config options anymore. --- ghcide/src/Development/IDE/Core/Shake.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index f2bb83a92b..b5feb2f56b 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -163,6 +163,7 @@ import Debug.Trace.Flags (userTracingEnabled) import qualified Development.IDE.Types.Exports as ExportsMap import HieDb.Types import Ide.Plugin.Config +import Ide.Plugin.Properties (useProperty) import qualified Ide.PluginUtils as HLS import Ide.Types (PluginId) @@ -308,7 +309,14 @@ instance IsIdeGlobal GlobalIdeOptions getIdeOptions :: Action IdeOptions getIdeOptions = do GlobalIdeOptions x <- getIdeGlobalAction - return x + env <- lspEnv <$> getShakeExtras + case env of + Nothing -> return x + Just env -> do + config <- liftIO $ LSP.runLspT env HLS.getClientConfig + return x{optCheckProject = pure $ checkProject config, + optCheckParents = pure $ checkParents config + } getIdeOptionsIO :: ShakeExtras -> IO IdeOptions getIdeOptionsIO ide = do From c54a93d601c96d54080867ea3edcc2e3edf3e677 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 27 Nov 2021 12:34:28 +0000 Subject: [PATCH 4/5] redundant import --- ghcide/src/Development/IDE/Core/Shake.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index b5feb2f56b..24281a5cae 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -163,7 +163,6 @@ import Debug.Trace.Flags (userTracingEnabled) import qualified Development.IDE.Types.Exports as ExportsMap import HieDb.Types import Ide.Plugin.Config -import Ide.Plugin.Properties (useProperty) import qualified Ide.PluginUtils as HLS import Ide.Types (PluginId) From 78c448094d087a668821c69f7f48e046752bd6f7 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 27 Nov 2021 12:34:35 +0000 Subject: [PATCH 5/5] fix tests --- ghcide/test/exe/Main.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f85105af35..e198c402a7 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -427,10 +427,7 @@ diagnosticTests = testGroup "diagnostics" liftIO $ writeFile (path "hie.yaml") cradle _ <- createDoc "ModuleD.hs" "haskell" contentD expectDiagnostics - [ ( "ModuleA.hs" - , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")] - ) - , ( "ModuleB.hs" + [ ( "ModuleB.hs" , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")] ) ] @@ -1780,6 +1777,7 @@ suggestImportTests = testGroup "suggest import actions" test = test' False wantWait = test' True True test' waitForCheckProject wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do + configureCheckProject waitForCheckProject let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, B]}}" @@ -5322,6 +5320,7 @@ ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do ifaceErrorTest :: TestTree ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \dir -> do + configureCheckProject True let bPath = dir "B.hs" pPath = dir "P.hs" @@ -5686,6 +5685,8 @@ getReferences' (file, l, c) includeDeclaration = do referenceTestSession :: String -> FilePath -> [FilePath] -> (FilePath -> Session ()) -> TestTree referenceTestSession name thisDoc docs' f = testSessionWithExtraFiles "references" name $ \dir -> do + -- needed to build whole project indexing + configureCheckProject True let docs = map (dir ) $ delete thisDoc $ nubOrd docs' -- Initial Index docid <- openDoc thisDoc "haskell"