hls-test-utils 1.4.0.0 → 1.5.0.0

raw patch · 3 files changed

+235/−110 lines, 3 filesdep ~ghcidedep ~hls-plugin-apiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghcide, hls-plugin-api

API changes (from Hackage documentation)

Files

• hls-test-utils.cabal +3/−3
• src/Test/Hls.hs +213/−41
• src/Test/Hls/Util.hs +19/−66

@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          hls-test-utils-version:       1.4.0.0+version:       1.5.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>@@ -41,9 +41,9 @@     , directory     , extra     , filepath-    , ghcide                  ^>=1.8+    , ghcide                  ^>=1.9     , hls-graph-    , hls-plugin-api          ^>=1.5+    , hls-plugin-api          ^>=1.6     , lens     , lsp                     ^>=1.6.0.0     , lsp-test                ^>=0.14

@@ -16,15 +16,22 @@     defaultTestRunner,     goldenGitDiff,     goldenWithHaskellDoc,+    goldenWithCabalDoc,     goldenWithHaskellDocFormatter,+    goldenWithCabalDocFormatter,     def,+    -- * Running HLS for integration tests     runSessionWithServer,+    runSessionWithServerAndCaps,     runSessionWithServerFormatter,+    runSessionWithCabalServerFormatter,     runSessionWithServer',-    waitForProgressDone,-    waitForAllProgressDone,+    -- * Helpful re-exports     PluginDescriptor,     IdeState,+    -- * Assertion helper functions+    waitForProgressDone,+    waitForAllProgressDone,     waitForBuildQueue,     waitForTypecheck,     waitForAction,@@ -32,6 +39,16 @@     getLastBuildKeys,     waitForKickDone,     waitForKickStart,+    -- * Plugin descriptor helper functions for tests+    PluginTestDescriptor,+    pluginTestRecorder,+    mkPluginTestDescriptor,+    mkPluginTestDescriptor',+    -- * Re-export logger types+    -- Avoids slightly annoying ghcide imports when they are unnecessary.+    WithPriority(..),+    Recorder,+    Priority(..),     ) where @@ -40,6 +57,7 @@ import           Control.Concurrent.Extra import           Control.Exception.Base import           Control.Monad                   (guard, unless, void)+import           Control.Monad.Extra             (forM) import           Control.Monad.IO.Class import           Data.Aeson                      (Result (Success),                                                   Value (Null), fromJSON,@@ -59,7 +77,7 @@ import           Development.IDE.Plugin.Test     (TestRequest (GetBuildKeysBuilt, WaitForIdeRule, WaitForShakeQueue),                                                   WaitForIdeRuleResult (ideResultSuccess)) import qualified Development.IDE.Plugin.Test     as Test-import           Development.IDE.Types.Logger    (Logger (Logger),+import           Development.IDE.Types.Logger    (Doc, Logger (Logger),                                                   Pretty (pretty),                                                   Priority (Debug),                                                   Recorder (Recorder, logger_),@@ -69,10 +87,6 @@ import           Development.IDE.Types.Options import           GHC.IO.Handle import           GHC.Stack                       (emptyCallStack)-import           Ide.Plugin.Config               (Config, PluginConfig,-                                                  formattingProvider, plugins)-import           Ide.PluginUtils                 (idePluginsToPluginDesc,-                                                  pluginDescToIdePlugins) import           Ide.Types import           Language.LSP.Test import           Language.LSP.Types              hiding@@ -94,6 +108,7 @@ import           Test.Tasty.Golden import           Test.Tasty.HUnit import           Test.Tasty.Ingredients.Rerun+import           Test.Tasty.Runners              (NumThreads (..))  newtype Log = LogIDEMain IDEMain.Log @@ -103,7 +118,7 @@  -- | Run 'defaultMainWithRerun', limiting each single test case running at most 10 minutes defaultTestRunner :: TestTree -> IO ()-defaultTestRunner = defaultMainWithRerun . adjustOption (const $ mkTimeout 600000000)+defaultTestRunner = defaultMainWithRerun . adjustOption (const $ NumThreads 1) . adjustOption (const $ mkTimeout 600000000)  gitDiff :: FilePath -> FilePath -> [String] gitDiff fRef fNew = ["git", "-c", "core.fileMode=false", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]@@ -112,7 +127,8 @@ goldenGitDiff name = goldenVsStringDiff name gitDiff  goldenWithHaskellDoc-  :: PluginDescriptor IdeState+  :: Pretty b+  => PluginTestDescriptor b   -> TestName   -> FilePath   -> FilePath@@ -120,25 +136,161 @@   -> FilePath   -> (TextDocumentIdentifier -> Session ())   -> TestTree-goldenWithHaskellDoc plugin title testDataDir path desc ext act =+goldenWithHaskellDoc = goldenWithDoc "haskell"++goldenWithCabalDoc+  :: Pretty b+  => PluginTestDescriptor b+  -> TestName+  -> FilePath+  -> FilePath+  -> FilePath+  -> FilePath+  -> (TextDocumentIdentifier -> Session ())+  -> TestTree+goldenWithCabalDoc = goldenWithDoc "cabal"++goldenWithDoc+  :: Pretty b+  => T.Text+  -> PluginTestDescriptor b+  -> TestName+  -> FilePath+  -> FilePath+  -> FilePath+  -> FilePath+  -> (TextDocumentIdentifier -> Session ())+  -> TestTree+goldenWithDoc fileType plugin title testDataDir path desc ext act =   goldenGitDiff title (testDataDir </> path <.> desc <.> ext)   $ runSessionWithServer plugin testDataDir   $ TL.encodeUtf8 . TL.fromStrict   <$> do-    doc <- openDoc (path <.> ext) "haskell"+    doc <- openDoc (path <.> ext) fileType     void waitForBuildQueue     act doc     documentContents doc +-- ------------------------------------------------------------+-- Helper function for initialising plugins under test+-- ------------------------------------------------------------++-- | Plugin under test where a fitting recorder is injected.+type PluginTestDescriptor b = Recorder (WithPriority b) -> PluginDescriptor IdeState++-- | Wrap a plugin you want to test, and inject a fitting recorder as required.+--+-- If you want to write the logs to stderr, run your tests with+-- "HLS_TEST_PLUGIN_LOG_STDERR=1", e.g.+--+-- @+--   HLS_TEST_PLUGIN_LOG_STDERR=1 cabal test <test-suite-of-plugin>+-- @+--+--+-- To write all logs to stderr, including logs of the server, use:+--+-- @+--   HLS_TEST_LOG_STDERR=1 cabal test <test-suite-of-plugin>+-- @+mkPluginTestDescriptor+  :: (Recorder (WithPriority b) -> PluginId -> PluginDescriptor IdeState)+  -> PluginId+  -> PluginTestDescriptor b+mkPluginTestDescriptor pluginDesc plId recorder = pluginDesc recorder plId++-- | Wrap a plugin you want to test.+--+-- Ideally, try to migrate this plugin to co-log logger style architecture.+-- Therefore, you should prefer 'mkPluginTestDescriptor' to this if possible.+mkPluginTestDescriptor'+  :: (PluginId -> PluginDescriptor IdeState)+  -> PluginId+  -> PluginTestDescriptor b+mkPluginTestDescriptor' pluginDesc plId _recorder = pluginDesc plId++-- | Initialise a recorder that can be instructed to write to stderr by+-- setting the environment variable "HLS_TEST_PLUGIN_LOG_STDERR=1" before+-- running the tests.+--+-- On the cli, use for example:+--+-- @+--   HLS_TEST_PLUGIN_LOG_STDERR=1 cabal test <test-suite-of-plugin>+-- @+--+-- To write all logs to stderr, including logs of the server, use:+--+-- @+--   HLS_TEST_LOG_STDERR=1 cabal test <test-suite-of-plugin>+-- @+pluginTestRecorder :: Pretty a => IO (Recorder (WithPriority a))+pluginTestRecorder = do+  (recorder, _) <- initialiseTestRecorder ["HLS_TEST_PLUGIN_LOG_STDERR", "HLS_TEST_LOG_STDERR"]+  pure recorder++-- | Generic recorder initialisation for plugins and the HLS server for test-cases.+--+-- The created recorder writes to stderr if any of the given environment variables+-- have been set to a value different to @0@.+-- We allow multiple values, to make it possible to define a single environment variable+-- that instructs all recorders in the test-suite to write to stderr.+--+-- We have to return the base logger function for HLS server logging initialisation.+-- See 'runSessionWithServer'' for details.+initialiseTestRecorder :: Pretty a => [String] -> IO (Recorder (WithPriority a), WithPriority (Doc ann) -> IO ())+initialiseTestRecorder envVars = do+    docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug+    -- There are potentially multiple environment variables that enable this logger+    definedEnvVars <- forM envVars (\var -> fromMaybe "0" <$> lookupEnv var)+    let logStdErr = any (/= "0") definedEnvVars++        docWithFilteredPriorityRecorder =+          if logStdErr then cfilter (\WithPriority{ priority } -> priority >= Debug) docWithPriorityRecorder+          else mempty++        Recorder {logger_} = docWithFilteredPriorityRecorder++    pure (cmapWithPrio pretty docWithFilteredPriorityRecorder, logger_)++-- ------------------------------------------------------------+-- Run an HLS server testing a specific plugin+-- ------------------------------------------------------------++runSessionWithServer :: Pretty b => PluginTestDescriptor b -> FilePath -> Session a -> IO a+runSessionWithServer plugin fp act = do+  recorder <- pluginTestRecorder+  runSessionWithServer' [plugin recorder] def def fullCaps fp act++runSessionWithServerAndCaps :: Pretty b => PluginTestDescriptor b -> ClientCapabilities -> FilePath -> Session a -> IO a+runSessionWithServerAndCaps plugin caps fp act = do+  recorder <- pluginTestRecorder+  runSessionWithServer' [plugin recorder] def def caps fp act++runSessionWithServerFormatter :: Pretty b => PluginTestDescriptor b -> String -> PluginConfig -> FilePath -> Session a -> IO a+runSessionWithServerFormatter plugin formatter conf fp act = do+  recorder <- pluginTestRecorder+  runSessionWithServer'+    [plugin recorder]+    def+      { formattingProvider = T.pack formatter+      , plugins = M.singleton (PluginId $ T.pack formatter) conf+      }+    def+    fullCaps+    fp+    act+ goldenWithHaskellDocFormatter-  :: PluginDescriptor IdeState-  -> String+  :: Pretty b+  => PluginTestDescriptor b -- ^ Formatter plugin to be used+  -> String -- ^ Name of the formatter to be used   -> PluginConfig-  -> TestName-  -> FilePath-  -> FilePath-  -> FilePath-  -> FilePath+  -> TestName -- ^ Title of the test+  -> FilePath -- ^ Directory of the test data to be used+  -> FilePath -- ^ Path to the testdata to be used within the directory+  -> FilePath -- ^ Additional suffix to be appended to the output file+  -> FilePath -- ^ Extension of the output file   -> (TextDocumentIdentifier -> Session ())   -> TestTree goldenWithHaskellDocFormatter plugin formatter conf title testDataDir path desc ext act =@@ -151,19 +303,40 @@     act doc     documentContents doc -runSessionWithServer :: PluginDescriptor IdeState -> FilePath -> Session a -> IO a-runSessionWithServer plugin = runSessionWithServer' [plugin] def def fullCaps+goldenWithCabalDocFormatter+  :: Pretty b+  => PluginTestDescriptor b -- ^ Formatter plugin to be used+  -> String -- ^ Name of the formatter to be used+  -> PluginConfig+  -> TestName -- ^ Title of the test+  -> FilePath -- ^ Directory of the test data to be used+  -> FilePath -- ^ Path to the testdata to be used within the directory+  -> FilePath -- ^ Additional suffix to be appended to the output file+  -> FilePath -- ^ Extension of the output file+  -> (TextDocumentIdentifier -> Session ())+  -> TestTree+goldenWithCabalDocFormatter plugin formatter conf title testDataDir path desc ext act =+  goldenGitDiff title (testDataDir </> path <.> desc <.> ext)+  $ runSessionWithCabalServerFormatter plugin formatter conf testDataDir+  $ TL.encodeUtf8 . TL.fromStrict+  <$> do+    doc <- openDoc (path <.> ext) "cabal"+    void waitForBuildQueue+    act doc+    documentContents doc -runSessionWithServerFormatter :: PluginDescriptor IdeState -> String -> PluginConfig -> FilePath -> Session a -> IO a-runSessionWithServerFormatter plugin formatter conf =+runSessionWithCabalServerFormatter :: Pretty b => PluginTestDescriptor b -> String -> PluginConfig -> FilePath -> Session a -> IO a+runSessionWithCabalServerFormatter plugin formatter conf fp act = do+  recorder <- pluginTestRecorder   runSessionWithServer'-    [plugin]+    [plugin recorder]     def-      { formattingProvider = T.pack formatter-      , plugins = M.singleton (T.pack formatter) conf+      { cabalFormattingProvider = T.pack formatter+      , plugins = M.singleton (PluginId $ T.pack formatter) conf       }     def     fullCaps+    fp act  -- | Restore cwd after running an action keepCurrentDirectory :: IO a -> IO a@@ -174,11 +347,13 @@ 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+  -- | Plugins to load on the server.+  --+  -- For improved logging, make sure these plugins have been initalised with+  -- the recorder produced by @pluginTestRecorder@.   [PluginDescriptor IdeState] ->   -- | lsp config for the server   Config ->@@ -192,26 +367,24 @@     (inR, inW) <- createPipe     (outR, outW) <- createPipe -    docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug--    logStdErr <- fromMaybe "0" <$> lookupEnv "LSP_TEST_LOG_STDERR"+    -- Allow three environment variables, because "LSP_TEST_LOG_STDERR" has been used before,+    -- (thus, backwards compatibility) and "HLS_TEST_SERVER_LOG_STDERR" because it+    -- uses a more descriptive name.+    -- It is also in better accordance with 'pluginTestRecorder' which uses "HLS_TEST_PLUGIN_LOG_STDERR".+    -- At last, "HLS_TEST_LOG_STDERR" is intended to enable all logging for the server and the plugins+    -- under test.+    (recorder, logger_) <- initialiseTestRecorder+      ["LSP_TEST_LOG_STDERR", "HLS_TEST_SERVER_LOG_STDERR", "HLS_TEST_LOG_STDERR"]      let-        docWithFilteredPriorityRecorder@Recorder{ logger_ } =-            if logStdErr == "0" then mempty-            else cfilter (\WithPriority{ priority } -> priority >= Debug) docWithPriorityRecorder-         -- exists until old logging style is phased out         logger = Logger $ \p m -> logger_ (WithPriority p emptyCallStack (pretty m)) -        recorder = cmapWithPrio pretty docWithFilteredPriorityRecorder+        hlsPlugins = IdePlugins $ Test.blockCommandDescriptor "block-command" : plugins -        arguments@Arguments{ argsHlsPlugins, argsIdeOptions, argsLogger } = defaultArguments (cmapWithPrio LogIDEMain recorder) logger+        arguments@Arguments{ argsIdeOptions, argsLogger } =+            testing (cmapWithPrio LogIDEMain recorder) logger hlsPlugins -        hlsPlugins =-            plugins-            ++ [Test.blockCommandDescriptor "block-command", Test.plugin]-            ++ idePluginsToPluginDesc argsHlsPlugins         ideOptions config ghcSession =             let defIdeOptions = argsIdeOptions config ghcSession             in defIdeOptions@@ -227,7 +400,6 @@                 , argsDefaultHlsConfig = conf                 , argsLogger = argsLogger                 , argsIdeOptions = ideOptions-                , argsHlsPlugins = pluginDescToIdePlugins hlsPlugins                 }      x <- runSessionWithHandles inW outR sconf caps root s

@@ -6,37 +6,40 @@ {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE TypeOperators         #-} module Test.Hls.Util-  (+  (  -- * Test Capabilities       codeActionSupportCaps     , expectCodeAction-    , dontExpectCodeAction-    , expectDiagnostic-    , expectNoMoreDiagnostics-    , expectSameLocations-    , failIfSessionTimeout-    , flushStackEnvironment-    , fromAction-    , fromCommand-    , getCompletionByLabel+    -- * Environment specifications+    -- for ignoring tests     , ghcVersion, GhcVersion(..)     , hostOS, OS(..)     , matchesCurrentEnv, EnvSpec(..)-    , noLiteralCaps     , ignoreForGhcVersions     , ignoreInEnv     , onlyRunForGhcVersions-    , inspectCodeAction-    , inspectCommand-    , inspectDiagnostic     , knownBrokenOnWindows     , knownBrokenForGhcVersions     , knownBrokenInEnv     , onlyWorkForGhcVersions-    , setupBuildToolFiles+    -- * Extract code actions+    , fromAction+    , fromCommand+    -- * Session Assertion Helpers+    , dontExpectCodeAction+    , expectDiagnostic+    , expectNoMoreDiagnostics+    , expectSameLocations+    , failIfSessionTimeout+    , getCompletionByLabel+    , noLiteralCaps+    , inspectCodeAction+    , inspectCommand+    , inspectDiagnostic     , SymbolLocation     , waitForDiagnosticsFrom     , waitForDiagnosticsFromSource     , waitForDiagnosticsFromSourceWithTimeout+    -- * Temporary directories     , withCurrentDirectoryInTmp     , withCurrentDirectoryInTmp'     , withCanonicalTempDir@@ -61,7 +64,6 @@ import           Language.LSP.Types.Lens         (textDocument) import qualified Language.LSP.Types.Lens         as L import           System.Directory-import           System.Environment import           System.FilePath import           System.Info.Extra               (isMac, isWindows) import qualified System.IO.Extra@@ -87,34 +89,9 @@     literalSupport = CodeActionLiteralSupport def  -- -----------------------------------------------------------------------setupBuildToolFiles :: IO ()-setupBuildToolFiles = do-  forM_ files setupDirectFilesIn--setupDirectFilesIn :: FilePath -> IO ()-setupDirectFilesIn f =-  writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents--+-- Environment specification for ignoring tests -- --------------------------------------------------------------------- -files :: [FilePath]-files =-  [  "./test/testdata/"-   -- , "./test/testdata/addPackageTest/cabal-exe/"-   -- , "./test/testdata/addPackageTest/hpack-exe/"-   -- , "./test/testdata/addPackageTest/cabal-lib/"-   -- , "./test/testdata/addPackageTest/hpack-lib/"-   -- , "./test/testdata/addPragmas/"-   -- , "./test/testdata/badProjects/cabal/"-   -- , "./test/testdata/completion/"-   -- , "./test/testdata/definition/"-   -- , "./test/testdata/gototest/"-   -- , "./test/testdata/redundantImportTest/"-   -- , "./test/testdata/wErrorTest/"-  ]- data EnvSpec = HostOS OS | GhcVer GhcVersion     deriving (Show, Eq) @@ -165,30 +142,6 @@     if ghcVersion `elem` vers     then const id     else ignoreTestBecause---- -----------------------------------------------------------------------hieYamlCradleDirectContents :: String-hieYamlCradleDirectContents = unlines-  [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN"-  , "cradle:"-  , "  direct:"-  , "    arguments:"-  , "      - -i."-  ]----- -----------------------------------------------------------------------flushStackEnvironment :: IO ()-flushStackEnvironment = do-  -- We need to clear these environment variables to prevent-  -- collisions with stack usages-  -- See https://github.com/commercialhaskell/stack/issues/4875-  unsetEnv "GHC_PACKAGE_PATH"-  unsetEnv "GHC_ENVIRONMENT"-  unsetEnv "HASKELL_PACKAGE_SANDBOX"-  unsetEnv "HASKELL_PACKAGE_SANDBOXES"  -- ---------------------------------------------------------------------