diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index a11f0fdccc..e088b782ad 100644 --- a/.github/workflows/test.yml +++ b/.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 diff --git a/cabal.project b/cabal.project index f3b33a86bc..be4fd619e0 100644 --- a/cabal.project +++ b/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 diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index f0ec162c34..e5731977b4 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/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 diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 10cb8eefb1..9a7436bd11 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} module Test.Hls ( module Test.Tasty.HUnit, module Test.Tasty, @@ -9,32 +10,53 @@ 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] @@ -42,5 +64,73 @@ gitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, 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 diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal index 6e875daf57..67d501efc5 100644 --- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal +++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal @@ -1,15 +1,17 @@ -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 -license: Apache-2.0 -license-file: LICENSE -author: The Haskell IDE Team -copyright: The Haskell IDE Team -maintainer: alan.zimm@gmail.com -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 + +license: Apache-2.0 +license-file: LICENSE +author: The Haskell IDE Team +copyright: The Haskell IDE Team +maintainer: alan.zimm@gmail.com +category: Development +build-type: Simple extra-source-files: LICENSE test/testdata/**/*.hs @@ -17,43 +19,30 @@ extra-source-files: 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 diff --git a/plugins/hls-brittany-plugin/test/Main.hs b/plugins/hls-brittany-plugin/test/Main.hs index 0d981947b5..4f8f185328 100644 --- a/plugins/hls-brittany-plugin/test/Main.hs +++ b/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 diff --git a/plugins/hls-brittany-plugin/test/Server.hs b/plugins/hls-brittany-plugin/test/Server.hs deleted file mode 100644 index 192103ec9c..0000000000 --- a/plugins/hls-brittany-plugin/test/Server.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Config -import Ide.Plugin.Brittany as B -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ B.descriptor "brittany" - ] <> - Ghcide.descriptors - , argsDefaultHlsConfig = def { formattingProvider = "brittany" } - } diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index 45433bd2a0..9c6db93102 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -45,29 +45,17 @@ library ghc-options: -Wno-unticked-promoted-constructors -executable test-server +test-suite tests + type: exitcode-stdio-1.0 default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-class-plugin - , hls-plugin-api - - 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-class-plugin:test-server -any - hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base , bytestring , filepath + , hls-class-plugin , hls-test-utils , lens , lsp-test diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index af8495e46b..140a540045 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -10,6 +10,7 @@ where import Control.Lens hiding ((<.>)) import qualified Data.ByteString.Lazy as BS import qualified Data.Text.Encoding as T +import qualified Ide.Plugin.Class as Class import qualified Language.LSP.Types.Lens as J import System.FilePath import Test.Hls @@ -17,11 +18,14 @@ import Test.Hls main :: IO () main = defaultTestRunner tests +plugin :: PluginDescriptor IdeState +plugin = Class.descriptor "class" + tests :: TestTree tests = testGroup "class" [ testCase "Produces addMinimalMethodPlaceholders code actions for one instance" $ do - runSession testCommand fullCaps classPath $ do + runSessionWithServer plugin classPath $ do doc <- openDoc "T1.hs" "haskell" _ <- waitForDiagnosticsFromSource doc "typecheck" caResults <- getAllCodeActions doc @@ -61,7 +65,7 @@ classPath = "test" "testdata" glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree glodenTest name fp deco execute = goldenGitDiff name (classPath fpWithDeco <.> "expected" <.> "hs") - $ runSession testCommand fullCaps classPath + $ runSessionWithServer plugin classPath $ do doc <- openDoc (fp <.> "hs") "haskell" _ <- waitForDiagnosticsFromSource doc "typecheck" diff --git a/plugins/hls-class-plugin/test/Server.hs b/plugins/hls-class-plugin/test/Server.hs deleted file mode 100644 index 584c52cd1b..0000000000 --- a/plugins/hls-class-plugin/test/Server.hs +++ /dev/null @@ -1,18 +0,0 @@ - -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import qualified Ide.Plugin.Class as Class -import Ide.Plugin.Config -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ Class.descriptor "class" - ] <> - Ghcide.descriptors - } diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index dc82d0a5de..b77747fac1 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -92,25 +92,12 @@ library DataKinds TypeOperators -executable test-server +test-suite tests + type: exitcode-stdio-1.0 default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-eval-plugin - , hls-plugin-api - - 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-eval-plugin:test-server -any - hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , aeson , base diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 3cc5935601..ae14832741 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -15,6 +15,7 @@ import Data.Aeson.Types (Result (Success)) import Data.List.Extra (nubOrdOn) import qualified Data.Text as T import qualified Data.Text.IO as T +import qualified Ide.Plugin.Eval as Eval import Ide.Plugin.Eval.Types (EvalParams (..)) import Language.LSP.Types.Lens (command, range, title) import System.Directory (doesFileExist) @@ -24,32 +25,35 @@ import Test.Hls main :: IO () main = defaultTestRunner tests +evalPlugin :: PluginDescriptor IdeState +evalPlugin = Eval.descriptor "eval" + tests :: TestTree tests = testGroup "eval" [ testCase "Produces Evaluate code lenses" $ - runSession testCommand fullCaps evalPath $ do + runSessionWithServer evalPlugin evalPath $ do doc <- openDoc "T1.hs" "haskell" lenses <- getEvalCodeLenses doc liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."] , testCase "Produces Refresh code lenses" $ - runSession testCommand fullCaps evalPath $ do + runSessionWithServer evalPlugin evalPath $ do doc <- openDoc "T2.hs" "haskell" lenses <- getEvalCodeLenses doc liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."] , testCase "Code lenses have ranges" $ - runSession testCommand fullCaps evalPath $ do + runSessionWithServer evalPlugin evalPath $ do doc <- openDoc "T1.hs" "haskell" lenses <- getEvalCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)] , testCase "Multi-line expressions have a multi-line range" $ do - runSession testCommand fullCaps evalPath $ do + runSessionWithServer evalPlugin evalPath $ do doc <- openDoc "T3.hs" "haskell" lenses <- getEvalCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)] , testCase "Executed expressions range covers only the expression" $ do - runSession testCommand fullCaps evalPath $ do + runSessionWithServer evalPlugin evalPath $ do doc <- openDoc "T2.hs" "haskell" lenses <- getEvalCodeLenses doc liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)] @@ -132,12 +136,10 @@ tests = "Can handle eval inside nested comment properly" $ goldenTest "TNested.hs" , testCase "Test on last line insert results correctly" $ do - runSession testCommand fullCaps evalPath $ - liftIO $ do - let mdl = "TLastLine.hs" - -- Write the test file, to make sure that it has no final line return - writeFile (evalPath mdl) "module TLastLine where\n\n-- >>> take 3 [1..]" - goldenTest mdl + let mdl = "TLastLine.hs" + -- Write the test file, to make sure that it has no final line return + writeFile (evalPath mdl) "module TLastLine where\n\n-- >>> take 3 [1..]" + goldenTest mdl , testGroup "with preprocessors" [ knownBrokenInEnv [HostOS Windows, GhcVer GHC84, GhcVer GHC86] "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $ @@ -160,7 +162,7 @@ goldenTest = goldenTestBy isEvalTest Compare results with the contents of corresponding '.expected' file (and creates it, if missing) -} goldenTestBy :: (CodeLens -> Bool) -> FilePath -> IO () -goldenTestBy fltr input = runSession testCommand fullCaps evalPath $ do +goldenTestBy fltr input = runSessionWithServer evalPlugin evalPath $ do doc <- openDoc input "haskell" -- Execute lenses backwards, to avoid affecting their position in the source file @@ -176,7 +178,7 @@ goldenTestBy fltr input = runSession testCommand fullCaps evalPath $ do edited <- replaceUnicodeQuotes <$> documentContents doc -- liftIO $ T.putStrLn edited - let expectedFile = evalPath input <.> "expected" + let expectedFile = input <.> "expected" liftIO $ do -- Write expected file if missing diff --git a/plugins/hls-eval-plugin/test/Server.hs b/plugins/hls-eval-plugin/test/Server.hs deleted file mode 100644 index a30263fc46..0000000000 --- a/plugins/hls-eval-plugin/test/Server.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Config -import qualified Ide.Plugin.Eval as Eval -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ Eval.descriptor "eval" - ] <> - Ghcide.descriptors - } 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 d799118cc1..38ed623ec5 100644 --- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal +++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal @@ -40,28 +40,16 @@ library DataKinds TypeOperators -executable test-server +test-suite tests + type: exitcode-stdio-1.0 default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-haddock-comments-plugin - , hls-plugin-api - - 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-haddock-comments-plugin:test-server -any - hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base , bytestring , filepath + , hls-haddock-comments-plugin , hls-test-utils , text diff --git a/plugins/hls-haddock-comments-plugin/test/Main.hs b/plugins/hls-haddock-comments-plugin/test/Main.hs index b1ad5d8454..5bc2817e8e 100644 --- a/plugins/hls-haddock-comments-plugin/test/Main.hs +++ b/plugins/hls-haddock-comments-plugin/test/Main.hs @@ -11,17 +11,21 @@ module Main ) where -import qualified Data.ByteString.Lazy as LBS -import Data.Foldable (find) -import Data.Maybe (mapMaybe) -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import System.FilePath ((<.>), ()) +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable (find) +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import qualified Ide.Plugin.HaddockComments as HaddockComments +import System.FilePath ((<.>), ()) import Test.Hls main :: IO () main = defaultTestRunner tests +plugin :: PluginDescriptor IdeState +plugin = HaddockComments.descriptor "haddockComments" + tests :: TestTree tests = testGroup @@ -38,7 +42,7 @@ tests = goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree goldenTest fp (toTitle -> expectedTitle) l c = goldenGitDiff (fp <> " (golden)") goldenFilePath $ - runSession testCommand fullCaps haddockCommentsPath $ do + runSessionWithServer plugin haddockCommentsPath $ do doc <- openDoc hsFilePath "haskell" actions <- getCodeActions doc (Range (Position l c) (Position l $ succ c)) case find ((== Just expectedTitle) . caTitle) actions of @@ -52,7 +56,7 @@ goldenTest fp (toTitle -> expectedTitle) l c = goldenGitDiff (fp <> " (golden)") expectedNothing :: FilePath -> GenCommentsType -> Int -> Int -> TestTree expectedNothing fp (toTitle -> expectedTitle) l c = testCase fp $ - runSession testCommand fullCaps haddockCommentsPath $ do + runSessionWithServer plugin haddockCommentsPath $ do doc <- openDoc (fp <.> "hs") "haskell" titles <- mapMaybe caTitle <$> getCodeActions doc (Range (Position l c) (Position l $ succ c)) liftIO $ expectedTitle `notElem` titles @? "Unexpected CodeAction" diff --git a/plugins/hls-haddock-comments-plugin/test/Server.hs b/plugins/hls-haddock-comments-plugin/test/Server.hs deleted file mode 100644 index 1bb10f0abd..0000000000 --- a/plugins/hls-haddock-comments-plugin/test/Server.hs +++ /dev/null @@ -1,18 +0,0 @@ - -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Config -import qualified Ide.Plugin.HaddockComments as HaddockComments -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ HaddockComments.descriptor "haddockComments" - ] <> - Ghcide.descriptors - } diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index fbefeebda2..5020d55b0d 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -19,8 +19,8 @@ category: Development build-type: Simple extra-source-files: LICENSE - test/testdata/*.expected test/testdata/*.error + test/testdata/*.expected test/testdata/*.hs test/testdata/*.yaml @@ -57,25 +57,12 @@ library DataKinds TypeOperators -executable test-server +test-suite tests + type: exitcode-stdio-1.0 default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-plugin-api - , hls-splice-plugin - - 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-splice-plugin:test-server -any - hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base , directory diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs index 53cc62ed88..517fafa7a5 100644 --- a/plugins/hls-splice-plugin/test/Main.hs +++ b/plugins/hls-splice-plugin/test/Main.hs @@ -13,6 +13,7 @@ import Data.List (find) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T +import qualified Ide.Plugin.Splice as Splice import Ide.Plugin.Splice.Types import System.Directory import System.FilePath @@ -22,6 +23,9 @@ import Test.Hls main :: IO () main = defaultTestRunner tests +plugin :: PluginDescriptor IdeState +plugin = Splice.descriptor "splice" + tests :: TestTree tests = testGroup @@ -64,7 +68,7 @@ tests = goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree goldenTest input tc line col = testCase (input <> " (golden)") $ do - runSession testCommand fullCaps spliceTestPath $ do + runSessionWithServer plugin spliceTestPath $ do doc <- openDoc input "haskell" _ <- waitForDiagnostics actions <- getCodeActions doc $ pointRange line col @@ -73,7 +77,7 @@ goldenTest input tc line col = executeCommand c _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) edited <- documentContents doc - let expected_name = spliceTestPath input <.> "expected" + let expected_name = input <.> "expected" -- Write golden tests if they don't already exist liftIO $ (doesFileExist expected_name >>=) $ @@ -86,7 +90,7 @@ goldenTest input tc line col = goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree goldenTestWithEdit input tc line col = testCase (input <> " (golden)") $ do - runSession testCommand fullCaps spliceTestPath $ do + runSessionWithServer plugin spliceTestPath $ do doc <- openDoc input "haskell" orig <- documentContents doc let lns = T.lines orig @@ -96,7 +100,7 @@ goldenTestWithEdit input tc line col = , _end = Position (length lns + 1) 1 } liftIO $ sleep 3 - alt <- liftIO $ T.readFile (spliceTestPath input <.> "error") + alt <- liftIO $ T.readFile (input <.> "error") void $ applyEdit doc $ TextEdit theRange alt changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt] void waitForDiagnostics @@ -106,7 +110,7 @@ goldenTestWithEdit input tc line col = executeCommand c _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) edited <- documentContents doc - let expected_name = spliceTestPath input <.> "expected" + let expected_name = input <.> "expected" -- Write golden tests if they don't already exist liftIO $ (doesFileExist expected_name >>=) $ diff --git a/plugins/hls-splice-plugin/test/Server.hs b/plugins/hls-splice-plugin/test/Server.hs deleted file mode 100644 index 3bf0d1460c..0000000000 --- a/plugins/hls-splice-plugin/test/Server.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Config -import qualified Ide.Plugin.Splice as Splice -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ Splice.descriptor "splice" - ] <> - Ghcide.descriptors - } 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 051fbe40bf..0ce04597da 100644 --- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal +++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal @@ -31,27 +31,15 @@ library default-language: Haskell2010 -executable test-server +test-suite tests + type: exitcode-stdio-1.0 default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-plugin-api - , hls-stylish-haskell-plugin - - 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-stylish-haskell-plugin:test-server -any - hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , base , bytestring + , hls-stylish-haskell-plugin , hls-test-utils , text diff --git a/plugins/hls-stylish-haskell-plugin/test/Main.hs b/plugins/hls-stylish-haskell-plugin/test/Main.hs index 6f0431274f..311e43172a 100644 --- a/plugins/hls-stylish-haskell-plugin/test/Main.hs +++ b/plugins/hls-stylish-haskell-plugin/test/Main.hs @@ -1,21 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} 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.ByteString.Lazy as BS +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as T +import qualified Ide.Plugin.StylishHaskell as StylishHaskell +import Test.Hls main :: IO () main = defaultTestRunner tests +plugin :: PluginDescriptor IdeState +plugin = StylishHaskell.descriptor "stylishHaskell" + tests :: TestTree tests = testGroup "stylish-haskell" [ - goldenGitDiff "formats a document" "test/testdata/StylishHaskell.formatted_document.hs" $ runSession testCommand fullCaps "test/testdata" $ do + goldenGitDiff "formats a document" "test/testdata/StylishHaskell.formatted_document.hs" $ runSessionWithServerFormatter plugin "stylishHaskell" "test/testdata" $ do doc <- openDoc "StylishHaskell.hs" "haskell" formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing) BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , goldenGitDiff "formats a range" "test/testdata/StylishHaskell.formatted_range.hs" $ runSession testCommand fullCaps "test/testdata" $ do + , goldenGitDiff "formats a range" "test/testdata/StylishHaskell.formatted_range.hs" $ runSessionWithServerFormatter plugin "stylishHaskell" "test/testdata" $ do doc <- openDoc "StylishHaskell.hs" "haskell" formatRange doc (FormattingOptions 2 True Nothing Nothing Nothing) (Range (Position 0 0) (Position 2 21)) BS.fromStrict . T.encodeUtf8 <$> documentContents doc diff --git a/plugins/hls-stylish-haskell-plugin/test/Server.hs b/plugins/hls-stylish-haskell-plugin/test/Server.hs deleted file mode 100644 index 0d3389cf69..0000000000 --- a/plugins/hls-stylish-haskell-plugin/test/Server.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Config -import qualified Ide.Plugin.StylishHaskell as StylishHaskell -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ StylishHaskell.descriptor "stylish-haskell" - ] <> - Ghcide.descriptors - , argsDefaultHlsConfig = def { formattingProvider = "stylish-haskell" } - } diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 357883a479..e1f051f652 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -107,22 +107,6 @@ library TypeOperators, ViewPatterns - -executable test-server - default-language: Haskell2010 - build-depends: - , base - , data-default - , ghcide - , hls-tactics-plugin - , hls-plugin-api - , shake - main-is: Server.hs - hs-source-dirs: test - ghc-options: - "-with-rtsopts=-I0 -A128M" - -threaded -Wall -Wno-name-shadowing -Wredundant-constraints - test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs @@ -144,34 +128,21 @@ test-suite tests QuickCheck , aeson , base - , bytestring - , checkers , containers - , data-default - , deepseq , directory , filepath , ghc , ghcide >= 0.7.5.0 - , hie-bios , hls-plugin-api , hls-tactics-plugin + , hls-test-utils + , lsp-types , hspec , hspec-expectations , lens - , lsp-test - , lsp-types - , megaparsec , mtl - , tasty - , tasty-ant-xml >=1.1.6 - , tasty-expected-failure - , tasty-golden - , tasty-hunit - , tasty-rerun , text build-tool-depends: hspec-discover:hspec-discover - , hls-tactics-plugin:test-server -any default-language: Haskell2010 diff --git a/plugins/hls-tactics-plugin/test/Server.hs b/plugins/hls-tactics-plugin/test/Server.hs deleted file mode 100644 index 9b1c88b5f8..0000000000 --- a/plugins/hls-tactics-plugin/test/Server.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main(main) where - -import Data.Default -import Development.IDE.Main -import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Plugin.Tactic as T -import Ide.PluginUtils - -main :: IO () -main = defaultMain def - { argsHlsPlugins = pluginDescToIdePlugins $ - [ T.descriptor "tactics" - ] <> - Ghcide.descriptors - } - diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index 4dae186079..a985b78e7c 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -7,12 +7,10 @@ module Utils where -import Control.Applicative.Combinators (skipManyTill) import Control.Lens hiding (failing, (<.>), (.=)) import Control.Monad (unless) import Control.Monad.IO.Class import Data.Aeson -import Data.Default (Default (def)) import Data.Foldable import qualified Data.Map as M import Data.Maybe @@ -22,13 +20,15 @@ import qualified Ide.Plugin.Config as Plugin import Wingman.FeatureSet (FeatureSet, allFeatures, prettyFeatureSet) import Wingman.LanguageServer (mkShowMessageParams) import Wingman.Types -import Language.LSP.Test -import Language.LSP.Types import Language.LSP.Types.Lens hiding (actions, applyEdit, capabilities, executeCommand, id, line, message, name, rename, title) import System.Directory (doesFileExist) import System.FilePath import Test.Hspec +import Test.Hls +import Ide.Plugin.Tactic as Tactic +plugin :: PluginDescriptor IdeState +plugin = Tactic.descriptor "tactics" ------------------------------------------------------------------------------ -- | Get a range at the given line and column corresponding to having nothing @@ -63,7 +63,7 @@ mkTest ) -- ^ A collection of (un)expected code actions. -> SpecWith (Arg Bool) mkTest name fp line col ts = it name $ do - runSession testCommand fullCaps tacticPath $ do + runSessionWithServer plugin tacticPath $ do setFeatureSet allFeatures doc <- openDoc fp "haskell" _ <- waitForDiagnostics @@ -101,7 +101,7 @@ mkGoldenTest -> SpecWith () mkGoldenTest features tc occ line col input = it (input <> " (golden)") $ do - runSession testCommand fullCaps tacticPath $ do + runSessionWithServer plugin tacticPath $ do setFeatureSet features doc <- openDoc input "haskell" _ <- waitForDiagnostics @@ -111,7 +111,7 @@ mkGoldenTest features tc occ line col input = executeCommand c _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit) edited <- documentContents doc - let expected_name = tacticPath input <.> "expected" + let expected_name = input <.> "expected" -- Write golden tests if they don't already exist liftIO $ (doesFileExist expected_name >>=) $ flip unless $ do T.writeFile expected_name edited @@ -129,7 +129,7 @@ mkShowMessageTest -> SpecWith () mkShowMessageTest features tc occ line col input ufm = it (input <> " (golden)") $ do - runSession testCommand fullCaps tacticPath $ do + runSessionWithServer plugin tacticPath $ do setFeatureSet features doc <- openDoc input "haskell" _ <- waitForDiagnostics @@ -155,10 +155,6 @@ tacticPath :: FilePath tacticPath = "test/golden" -testCommand :: String -testCommand = "test-server" - - executeCommandWithResp :: Command -> Session (ResponseMessage 'WorkspaceExecuteCommand) executeCommandWithResp cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments