diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 1663a52f38..5f1defb027 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -86,7 +86,8 @@ import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) import qualified HieDb.Run as HieDb import Ide.Plugin.Config (CheckParents (NeverCheck), - Config, + Config, checkParents, + checkProject, getConfigFromNotification) import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) @@ -193,7 +194,10 @@ defaultArguments priority = Arguments , argsGhcidePlugin = mempty , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors , argsSessionLoadingOptions = def - , argsIdeOptions = const defaultIdeOptions + , argsIdeOptions = \config ghcSession -> (defaultIdeOptions ghcSession) + { optCheckProject = pure $ checkProject config + , optCheckParents = pure $ checkParents config + } , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."} , argsDefaultHlsConfig = def , argsGetHieDbLoc = getHieDbLoc diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 0002f6932b..ff53f1bca1 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -405,7 +405,7 @@ test-suite func-test , hspec-expectations , lens , ghcide - , hls-test-utils ^>= 1.1.0.0 + , hls-test-utils ^>= 1.2.0.0 , lsp-types , aeson , hls-plugin-api diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index dc25afb526..ce383a0b34 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-test-utils -version: 1.1.0.0 +version: 1.2.0.0 synopsis: Utilities used in the tests of Haskell Language Server description: Please see the README on GitHub at diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index dec2542f7a..f25b6a95fc 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -52,7 +52,8 @@ import Development.IDE.Plugin.Test (TestRequest (WaitForIdeRule, W import Development.IDE.Types.Options import GHC.IO.Handle import Ide.Plugin.Config (Config, formattingProvider) -import Ide.PluginUtils (idePluginsToPluginDesc, pluginDescToIdePlugins) +import Ide.PluginUtils (idePluginsToPluginDesc, + pluginDescToIdePlugins) import Ide.Types import Language.LSP.Test import Language.LSP.Types hiding @@ -84,17 +85,17 @@ goldenGitDiff :: TestName -> FilePath -> IO ByteString -> TestTree goldenGitDiff name = goldenVsStringDiff name gitDiff goldenWithHaskellDoc - :: PluginDescriptor IdeState + :: (FilePath -> Session ByteString -> IO ByteString) -> TestName -> FilePath -> FilePath -> FilePath - -> FilePath + -> String -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithHaskellDoc plugin title testDataDir path desc ext act = +goldenWithHaskellDoc runSessionTest title testDataDir path desc ext act = goldenGitDiff title (testDataDir path <.> desc <.> ext) - $ runSessionWithServer plugin testDataDir + $ runSessionTest testDataDir $ TL.encodeUtf8 . TL.fromStrict <$> do doc <- openDoc (path <.> ext) "haskell" @@ -224,7 +225,7 @@ waitForAction key TextDocumentIdentifier{_uri} = do return $ do e <- _result case A.fromJSON e of - A.Error err -> Left $ ResponseError InternalError (T.pack err) Nothing + A.Error err -> Left $ ResponseError InternalError (T.pack err) Nothing A.Success a -> pure a waitForTypecheck :: TextDocumentIdentifier -> Session (Either ResponseError Bool) diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal index fb7e57cfbe..6977424481 100644 --- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal +++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal @@ -48,4 +48,4 @@ test-suite tests , base , filepath , hls-brittany-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal index d54d0d5677..50e51b78c9 100644 --- a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal +++ b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal @@ -55,7 +55,7 @@ test-suite tests , extra , filepath , hls-call-hierarchy-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lens , lsp , lsp-test diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index 766965e1a9..33ee66284f 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -53,6 +53,6 @@ test-suite tests , base , filepath , hls-class-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lens , lsp-types diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index 9a69255030..56c4c81e98 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -54,7 +54,7 @@ _CACodeAction = prism' InR $ \case goldenWithClass :: TestName -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree goldenWithClass title path desc act = - goldenWithHaskellDoc classPlugin title testDataDir path (desc <.> "expected") "hs" $ \doc -> do + goldenWithHaskellDoc (runSessionWithServer classPlugin) title testDataDir path (desc <.> "expected") "hs" $ \doc -> do _ <- waitForDiagnosticsFromSource doc "typecheck" actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc act actions diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index 16232b61cc..62fe3d5f56 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -106,7 +106,8 @@ test-suite tests , extra , filepath , hls-eval-plugin - , hls-test-utils ^>=1.1 + , hls-plugin-api + , hls-test-utils ^>=1.2 , lens , lsp-types , text diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index f1faceeb16..ddb9a38ba4 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -12,13 +12,14 @@ import Data.Aeson (fromJSON) import Data.Aeson.Types (Result (Success)) import Data.List (isInfixOf) import Data.List.Extra (nubOrdOn) +import qualified Data.Text as T +import Ide.Plugin.Config (checkProject) import qualified Ide.Plugin.Eval as Eval import Ide.Plugin.Eval.Types (EvalParams (..), Section (..), testOutput) import Language.LSP.Types.Lens (arguments, command, range, title) import System.FilePath (()) import Test.Hls -import qualified Data.Text as T main :: IO () main = defaultTestRunner tests @@ -30,27 +31,27 @@ tests :: TestTree tests = testGroup "eval" [ testCase "Produces Evaluate code lenses" $ - runSessionWithServer evalPlugin testDataDir $ do + runS evalPlugin testDataDir $ do doc <- openDoc "T1.hs" "haskell" lenses <- getCodeLenses doc liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."] , testCase "Produces Refresh code lenses" $ - runSessionWithServer evalPlugin testDataDir $ do + runS evalPlugin testDataDir $ do doc <- openDoc "T2.hs" "haskell" lenses <- getCodeLenses doc liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."] , testCase "Code lenses have ranges" $ - runSessionWithServer evalPlugin testDataDir $ do + runS evalPlugin testDataDir $ do doc <- openDoc "T1.hs" "haskell" lenses <- getCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)] , testCase "Multi-line expressions have a multi-line range" $ do - runSessionWithServer evalPlugin testDataDir $ do + runS evalPlugin testDataDir $ do doc <- openDoc "T3.hs" "haskell" lenses <- getCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)] , testCase "Executed expressions range covers only the expression" $ do - runSessionWithServer evalPlugin testDataDir $ do + runS evalPlugin testDataDir $ do doc <- openDoc "T2.hs" "haskell" lenses <- getCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)] @@ -181,7 +182,7 @@ tests = goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree goldenWithEval title path ext = - goldenWithHaskellDoc evalPlugin title testDataDir path "expected" ext executeLensesBackwards + goldenWithHaskellDoc (runS evalPlugin) title testDataDir path "expected" ext executeLensesBackwards -- | Execute lenses backwards, to avoid affecting their position in the source file executeLensesBackwards :: TextDocumentIdentifier -> Session () @@ -208,7 +209,7 @@ executeCmd cmd = do pure () evalLenses :: FilePath -> IO [CodeLens] -evalLenses path = runSessionWithServer evalPlugin testDataDir $ do +evalLenses path = runS evalPlugin testDataDir $ do doc <- openDoc path "haskell" executeLensesBackwards doc getCodeLenses doc @@ -225,7 +226,7 @@ testDataDir :: FilePath testDataDir = "test" "testdata" evalInFile :: FilePath -> T.Text -> T.Text -> IO () -evalInFile fp e expected = runSessionWithServer evalPlugin testDataDir $ do +evalInFile fp e expected = runS evalPlugin testDataDir $ do doc <- openDoc fp "haskell" origin <- documentContents doc let withEval = origin <> e @@ -233,3 +234,9 @@ evalInFile fp e expected = runSessionWithServer evalPlugin testDataDir $ do executeLensesBackwards doc result <- fmap T.strip . T.stripPrefix withEval <$> documentContents doc liftIO $ result @?= Just (T.strip expected) + +-- Run with checkProject false to avoid loading all the test data modules, +-- which leads to flaky test failures due to how the Eval plugin mutates +-- the shared GHC session (this is because of how the InteractiveContext works) +runS :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a +runS plugin = runSessionWithServer' [plugin] def{checkProject = False} def fullCaps diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal index 89ef213b6f..b9bb348f31 100644 --- a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal +++ b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal @@ -40,4 +40,4 @@ test-suite tests , base , filepath , hls-floskell-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 3645687550..33114d3913 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -44,5 +44,5 @@ test-suite tests , base , filepath , hls-fourmolu-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lsp-test diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal index 2c7e20d74f..751d985c99 100644 --- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal +++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal @@ -50,5 +50,5 @@ test-suite tests , base , filepath , hls-haddock-comments-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , text diff --git a/plugins/hls-haddock-comments-plugin/test/Main.hs b/plugins/hls-haddock-comments-plugin/test/Main.hs index 2cfddadffc..0e8cc28342 100644 --- a/plugins/hls-haddock-comments-plugin/test/Main.hs +++ b/plugins/hls-haddock-comments-plugin/test/Main.hs @@ -37,7 +37,7 @@ tests = goldenWithHaddockComments :: FilePath -> GenCommentsType -> Int -> Int -> TestTree goldenWithHaddockComments fp (toTitle -> expectedTitle) l c = - goldenWithHaskellDoc haddockCommentsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do + goldenWithHaskellDoc (runSessionWithServer haddockCommentsPlugin) (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c)) case find ((== Just expectedTitle) . caTitle) actions of Just (InR x) -> executeCodeAction x diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 316bdf0f36..13abe61941 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -122,7 +122,7 @@ test-suite tests , filepath , hls-hlint-plugin , hls-plugin-api - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lens , lsp-types , text diff --git a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal index 61b6a31a8f..3ad3fb3ad6 100644 --- a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal +++ b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal @@ -44,4 +44,4 @@ test-suite tests , base , filepath , hls-module-name-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 diff --git a/plugins/hls-module-name-plugin/test/Main.hs b/plugins/hls-module-name-plugin/test/Main.hs index b6a35af926..ff76e8286a 100644 --- a/plugins/hls-module-name-plugin/test/Main.hs +++ b/plugins/hls-module-name-plugin/test/Main.hs @@ -40,7 +40,7 @@ tests = ] goldenWithModuleName :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithModuleName title path = goldenWithHaskellDoc moduleNamePlugin title testDataDir path "expected" "hs" +goldenWithModuleName title path = goldenWithHaskellDoc (runSessionWithServer moduleNamePlugin) title testDataDir path "expected" "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal index 740eafdfa0..0501629d40 100644 --- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal +++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal @@ -43,5 +43,5 @@ test-suite tests , base , filepath , hls-ormolu-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lsp-types diff --git a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal index 2096fe4f9d..f29b1170a7 100644 --- a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal +++ b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal @@ -44,7 +44,7 @@ test-suite tests , base , filepath , hls-pragmas-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , lens , lsp-types , text diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index ee62d80417..c262379905 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -111,7 +111,7 @@ completionTest testComment fileName te' label textFormat insertText detail [a, b item ^. L.detail @?= detail goldenWithPragmas :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithPragmas title path = goldenWithHaskellDoc pragmasPlugin title testDataDir path "expected" "hs" +goldenWithPragmas title path = goldenWithHaskellDoc (runSessionWithServer pragmasPlugin) title testDataDir path "expected" "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-refine-imports-plugin/test/Main.hs b/plugins/hls-refine-imports-plugin/test/Main.hs index 90c294cc24..5745933250 100644 --- a/plugins/hls-refine-imports-plugin/test/Main.hs +++ b/plugins/hls-refine-imports-plugin/test/Main.hs @@ -67,7 +67,7 @@ executeCmd cmd = do -- helpers goldenWithRefineImports :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree -goldenWithRefineImports fp = goldenWithHaskellDoc refineImportsPlugin (fp <> " (golden)") testDataDir fp "expected" "hs" +goldenWithRefineImports fp = goldenWithHaskellDoc (runSessionWithServer refineImportsPlugin) (fp <> " (golden)") testDataDir fp "expected" "hs" testDataDir :: String testDataDir = "test" "testdata" diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index 1d1499d44f..0f87245439 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -47,4 +47,4 @@ test-suite tests , base , filepath , hls-rename-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs index 31baec621c..6a51a6ab72 100644 --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -54,7 +54,7 @@ tests = testGroup "Rename" goldenWithRename :: TestName -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree goldenWithRename title path = - goldenWithHaskellDoc renamePlugin title testDataDir path "expected" "hs" + goldenWithHaskellDoc (runSessionWithServer renamePlugin) title testDataDir path "expected" "hs" testDataDir :: FilePath testDataDir = "test" "testdata" diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index 4f9d7600e5..0ec3075e96 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -64,5 +64,5 @@ test-suite tests , base , filepath , hls-splice-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , text diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs index 23c187846c..96a2d5d03b 100644 --- a/plugins/hls-splice-plugin/test/Main.hs +++ b/plugins/hls-splice-plugin/test/Main.hs @@ -63,7 +63,7 @@ tests = testGroup "splice" goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree goldenTest fp tc line col = - goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do + goldenWithHaskellDoc (runSessionWithServer splicePlugin) (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do _ <- waitForDiagnostics -- wait for the entire build to finish, so that code actions that -- use stale data will get uptodate stuff @@ -77,7 +77,7 @@ goldenTest fp tc line col = goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree goldenTestWithEdit fp tc line col = - goldenWithHaskellDoc splicePlugin (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do + goldenWithHaskellDoc (runSessionWithServer splicePlugin) (fp <> " (golden)") testDataDir fp "expected" "hs" $ \doc -> do orig <- documentContents doc let lns = T.lines orig diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal index c9c87210b6..40ff7bd7b8 100644 --- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal +++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal @@ -42,4 +42,4 @@ test-suite tests , base , filepath , hls-stylish-haskell-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index d1c82d8a36..bac1b953d4 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -160,7 +160,7 @@ test-suite tests , ghcide , hls-plugin-api , hls-tactics-plugin - , hls-test-utils >=1.0 && <1.2 + , hls-test-utils >=1.0 && <1.3 , hspec , hspec-expectations , lens