Run plugins' test suites with server in the same process

.github/workflows/test.yml

@@ -142,27 +142,27 @@ jobs:
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-brittany-plugin
-        run: cabal test hls-brittany-plugin || cabal test hls-brittany-plugin --test-options="-j1"
+        run: cabal test hls-brittany-plugin --test-options="-j1 --rerun-update" || cabal test hls-brittany-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-class-plugin
-        run: cabal test hls-class-plugin || cabal test hls-class-plugin --test-options="-j1"
+        run: cabal test hls-class-plugin --test-options="-j1 --rerun-update" || cabal test hls-class-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-eval-plugin
-        run: cabal test hls-eval-plugin --test-options="-j1 --rerun" || cabal test hls-eval-plugin --test-options="-j1 --rerun"
+        run: cabal test hls-eval-plugin --test-options="-j1 --rerun-update" || cabal test hls-eval-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-haddock-comments-plugin
-        run: cabal test hls-haddock-comments-plugin || cabal test hls-haddock-comments-plugin --test-options="-j1"
+        run: cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun-update" || cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-splice-plugin
-        run: cabal test hls-splice-plugin || cabal test hls-splice-plugin --test-options="-j1"
+        run: cabal test hls-splice-plugin --test-options="-j1 --rerun-update" || cabal test hls-splice-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-stylish-haskell-plugin
-        run: cabal test hls-stylish-haskell-plugin || cabal test hls-stylish-haskell-plugin --test-options="-j1"
+        run: cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun-update" || cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="-j1 --rerun"
 
       - if: ${{ needs.pre_job.outputs.should_skip != 'true' && matrix.test }}
         name: Test hls-tactics-plugin test suite

cabal.project

@@ -19,10 +19,6 @@ tests: true
 
 package *
   ghc-options: -haddock
-
-package haskell-language-server
-  test-show-details: direct
-package ghcide
   test-show-details: direct
 
 write-ghc-environment-files: never

hls-test-utils/hls-test-utils.cabal

@@ -34,6 +34,7 @@ library
   hs-source-dirs:   src
   build-depends:
     , aeson
+    , async
     , base
     , blaze-markup
     , bytestring
@@ -42,13 +43,16 @@ library
     , directory
     , extra
     , filepath
+    , ghcide                  ^>=1.1.0.0
+    , hls-plugin-api          ^>=1.1.0.0
     , hspec
     , hspec-core
     , lens
+    , lsp                     ^>=1.2
     , lsp-test                ==0.14.0.0
     , lsp-types               ^>=1.2
+    , shake
     , tasty
-    , tasty-ant-xml           >=1.1.6
     , tasty-expected-failure
     , tasty-golden
     , tasty-hunit

hls-test-utils/src/Test/Hls.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Test.Hls
   ( module Test.Tasty.HUnit,
     module Test.Tasty,
@@ -9,38 +10,127 @@ module Test.Hls
     module Control.Applicative.Combinators,
     defaultTestRunner,
     goldenGitDiff,
-    testCommand,
     def,
+    runSessionWithServer,
+    runSessionWithServerFormatter,
+    runSessionWithServer',
+    PluginDescriptor,
+    IdeState,
   )
 where
 
 import           Control.Applicative.Combinators
+import           Control.Concurrent.Async          (async, cancel, wait)
+import           Control.Concurrent.Extra
+import           Control.Exception.Base
 import           Control.Monad.IO.Class
-import           Data.ByteString.Lazy            (ByteString)
-import           Data.Default                    (def)
+import           Data.ByteString.Lazy              (ByteString)
+import           Data.Default                      (def)
+import qualified Data.Text                         as T
+import           Development.IDE                   (IdeState, hDuplicateTo',
+                                                    noLogging)
+import           Development.IDE.Main
+import qualified Development.IDE.Main              as Ghcide
+import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
+import           Development.IDE.Types.Options
+import           Development.Shake                 (ShakeOptions (shakeThreads))
+import           GHC.IO.Handle
+import           Ide.Plugin.Config                 (Config, formattingProvider)
+import           Ide.PluginUtils                   (pluginDescToIdePlugins)
+import           Ide.Types
 import           Language.LSP.Test
 import           Language.LSP.Types
+import           Language.LSP.Types.Capabilities   (ClientCapabilities)
+import           System.Directory                  (getCurrentDirectory,
+                                                    setCurrentDirectory)
+import           System.IO.Extra
+import           System.IO.Unsafe                  (unsafePerformIO)
+import           System.Process.Extra              (createPipe)
+import           System.Time.Extra
 import           Test.Hls.Util
-import           Test.Tasty                      hiding (Timeout)
+import           Test.Tasty                        hiding (Timeout)
 import           Test.Tasty.ExpectedFailure
 import           Test.Tasty.Golden
 import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
-import           Test.Tasty.Runners
-import           Test.Tasty.Runners.AntXML
 
--- | ingredient: xml runner writes json file of test results (https://github.com/ocharles/tasty-ant-xml/blob/master/Test/Tasty/Runners/AntXML.hs)
---               rerunningTests allow rerun of failed tests (https://github.com/ocharles/tasty-rerun/blob/master/src/Test/Tasty/Ingredients/Rerun.hs)
+-- | Run 'defaultMainWithRerun', limiting each single test case running at most 10 minutes
 defaultTestRunner :: TestTree -> IO ()
-defaultTestRunner =
-  defaultMainWithIngredients
-    [antXMLRunner, rerunningTests [listingTests, consoleTestReporter]]
+defaultTestRunner = defaultMainWithRerun . adjustOption (const $ mkTimeout 600000000)
 
 gitDiff :: FilePath -> FilePath -> [String]
 gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]
 
 goldenGitDiff :: TestName -> FilePath -> IO ByteString -> TestTree
 goldenGitDiff name = goldenVsStringDiff name gitDiff
 
-testCommand :: String
-testCommand = "test-server"
+runSessionWithServer :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a
+runSessionWithServer plugin = runSessionWithServer' [plugin] def def fullCaps
+
+runSessionWithServerFormatter :: PluginDescriptor IdeState -> String -> FilePath -> Session a -> IO a
+runSessionWithServerFormatter plugin formatter =
+  runSessionWithServer'
+    [plugin]
+    def {formattingProvider = T.pack formatter}
+    def
+    fullCaps
+
+-- | Run an action, with stderr silenced
+silenceStderr :: IO a -> IO a
+silenceStderr action = withTempFile $ \temp ->
+  bracket (openFile temp ReadWriteMode) hClose $ \h -> do
+    old <- hDuplicate stderr
+    buf <- hGetBuffering stderr
+    h `hDuplicateTo'` stderr
+    action `finally` do
+      old `hDuplicateTo'` stderr
+      hSetBuffering stderr buf
+      hClose old
+
+-- | Restore cwd after running an action
+keepCurrentDirectory :: IO a -> IO a
+keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
+
+{-# NOINLINE lock #-}
+-- | Never run in parallel
+lock :: Lock
+lock = unsafePerformIO newLock
+
+-- | Host a server, and run a test session on it
+-- Note: cwd will be shifted into @root@ in @Session a@
+runSessionWithServer' ::
+  -- | plugins to load on the server
+  [PluginDescriptor IdeState] ->
+  -- | lsp config for the server
+  Config ->
+  -- | config for the test session
+  SessionConfig ->
+  ClientCapabilities ->
+  FilePath ->
+  Session a ->
+  IO a
+runSessionWithServer' plugin conf sconf caps root s = withLock lock $ keepCurrentDirectory $ silenceStderr $ do
+  (inR, inW) <- createPipe
+  (outR, outW) <- createPipe
+  server <-
+    async $
+      Ghcide.defaultMain
+        def
+          { argsHandleIn = pure inR,
+            argsHandleOut = pure outW,
+            argsDefaultHlsConfig = conf,
+            argsLogger = pure noLogging,
+            argsIdeOptions = \config sessionLoader ->
+              let ideOptions = (argsIdeOptions def config sessionLoader) {optTesting = IdeTesting True}
+               in ideOptions {optShakeOptions = (optShakeOptions ideOptions) {shakeThreads = 2}},
+            argsHlsPlugins = pluginDescToIdePlugins $ plugin ++ Ghcide.descriptors
+          }
+  x <- runSessionWithHandles inW outR sconf caps root s
+  hClose inW
+  timeout 3 (wait server) >>= \case
+    Just () -> pure ()
+    Nothing -> do
+      putStrLn "Server does not exit in 3s, canceling the async task..."
+      (t, _) <- duration $ cancel server
+      putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
+  pure x

plugins/hls-brittany-plugin/hls-brittany-plugin.cabal

@@ -1,59 +1,48 @@
-cabal-version: 2.4
-name:          hls-brittany-plugin
-version:       1.0.0.0
-synopsis:      Integration with the Brittany code formatter
-description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
-license:       Apache-2.0
-license-file:  LICENSE
-author:        The Haskell IDE Team
-copyright:     The Haskell IDE Team
-maintainer:    [email protected]
-category:      Development
-build-type:    Simple
+cabal-version:      2.4
+name:               hls-brittany-plugin
+version:            1.0.0.0
+synopsis:           Integration with the Brittany code formatter
+description:
+  Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
+
+license:            Apache-2.0
+license-file:       LICENSE
+author:             The Haskell IDE Team
+copyright:          The Haskell IDE Team
+maintainer:         [email protected]
+category:           Development
+build-type:         Simple
 extra-source-files:
   LICENSE
   test/testdata/**/*.hs
 
 library
   exposed-modules:  Ide.Plugin.Brittany
   hs-source-dirs:   src
-  build-depends:    base             >=4.12 && <5
-               ,    brittany         >= 0.13.1.0
-               ,    filepath
-               ,    ghc
-               ,    ghc-boot-th
-               ,    ghcide           ^>= 1.1.0.0
-               ,    lsp-types
-               ,    hls-plugin-api   >= 1.0 && < 1.2
-               ,    lens
-               ,    text
-               ,    transformers
+  build-depends:
+    , base            >=4.12     && <5
+    , brittany        >=0.13.1.0
+    , filepath
+    , ghc
+    , ghc-boot-th
+    , ghcide          ^>=1.1.0.0
+    , hls-plugin-api  >=1.0      && <1.2
+    , lens
+    , lsp-types
+    , text
+    , transformers
 
   default-language: Haskell2010
 
-executable test-server
-  default-language:   Haskell2010
-  build-depends:
-    , base
-    , data-default
-    , ghcide
-    , hls-brittany-plugin
-    , hls-plugin-api
-    , shake
-  main-is: Server.hs
-  hs-source-dirs: test
-  ghc-options: -threaded
-
 test-suite tests
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  build-tool-depends:
-    hls-brittany-plugin:test-server -any,
-  hs-source-dirs: test
-  main-is: Main.hs
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , base
     , bytestring
     , hls-brittany-plugin
-    , text
     , hls-test-utils
+    , text

plugins/hls-brittany-plugin/test/Main.hs

@@ -2,32 +2,36 @@
 module Main(main) where
 
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
-import Test.Hls
+import qualified Data.Text.Encoding   as T
+import qualified Data.Text.IO         as T
+import qualified Ide.Plugin.Brittany  as Brittany
+import           Test.Hls
 
 main :: IO ()
 main = defaultTestRunner tests
 
+plugin :: PluginDescriptor IdeState
+plugin = Brittany.descriptor "brittany"
+
 tests :: TestTree
 tests = testGroup "brittany" [
-    goldenGitDiff "formats a document with LF endings" "test/testdata/BrittanyLF.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    goldenGitDiff "formats a document with LF endings" "test/testdata/BrittanyLF.formatted_document.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a document with CRLF endings" "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a document with CRLF endings" "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         formatDoc doc (FormattingOptions 4 True Nothing Nothing Nothing)
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a range with LF endings" "test/testdata/BrittanyLF.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a range with LF endings" "test/testdata/BrittanyLF.formatted_range.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) range
         BS.fromStrict . T.encodeUtf8 <$> documentContents doc
 
-    , goldenGitDiff "formats a range with CRLF endings" "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do
+    , goldenGitDiff "formats a range with CRLF endings" "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSessionWithServerFormatter plugin "brittany" "test/testdata" $ do
         doc <- openDoc "BrittanyCRLF.hs" "haskell"
         let range = Range (Position 1 0) (Position 2 22)
         formatRange doc (FormattingOptions 4 True Nothing Nothing Nothing) range