Attempt to fix the hls eval plugin test suite

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

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

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 <https://github.com/haskell/haskell-language-server#readme>

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)

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

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

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

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

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

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,11 +226,17 @@ 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
   changeDoc doc [TextDocumentContentChangeEvent Nothing Nothing withEval]
   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

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

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

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

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

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

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

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"

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

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

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"

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"

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

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"

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

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

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

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