Merge branch 'master' into wip/2.2.0.0

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

@@ -28,6 +28,7 @@ library
   exposed-modules:
     Test.Hls
     Test.Hls.Util
+    Test.Hls.FileSystem
 
   hs-source-dirs:   src
   build-depends:

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

@@ -21,15 +21,22 @@ module Test.Hls
     defaultTestRunner,
     goldenGitDiff,
     goldenWithHaskellDoc,
+    goldenWithHaskellDocInTmpDir,
     goldenWithHaskellAndCaps,
+    goldenWithHaskellAndCapsInTmpDir,
     goldenWithCabalDoc,
     goldenWithHaskellDocFormatter,
+    goldenWithHaskellDocFormatterInTmpDir,
     goldenWithCabalDocFormatter,
+    goldenWithCabalDocFormatterInTmpDir,
     def,
     -- * Running HLS for integration tests
     runSessionWithServer,
     runSessionWithServerAndCaps,
+    runSessionWithServerInTmpDir,
+    runSessionWithServerAndCapsInTmpDir,
     runSessionWithServer',
+    runSessionWithServerInTmpDir',
     -- * Helpful re-exports
     PluginDescriptor,
     IdeState,
@@ -90,11 +97,13 @@ import           GHC.Stack                          (emptyCallStack)
 import           GHC.TypeLits
 import           Ide.Logger                         (Doc, Logger (Logger),
                                                      Pretty (pretty),
-                                                     Priority (Debug),
+                                                     Priority (..),
                                                      Recorder (Recorder, logger_),
                                                      WithPriority (WithPriority, priority),
                                                      cfilter, cmapWithPrio,
-                                                     makeDefaultStderrRecorder)
+                                                     logWith,
+                                                     makeDefaultStderrRecorder,
+                                                     (<+>))
 import           Ide.Types
 import           Language.LSP.Protocol.Capabilities
 import           Language.LSP.Protocol.Message
@@ -105,9 +114,12 @@ import           System.Directory                   (getCurrentDirectory,
                                                      setCurrentDirectory)
 import           System.Environment                 (lookupEnv)
 import           System.FilePath
+import           System.IO.Extra                    (newTempDir, withTempDir)
 import           System.IO.Unsafe                   (unsafePerformIO)
 import           System.Process.Extra               (createPipe)
 import           System.Time.Extra
+import qualified Test.Hls.FileSystem                as FS
+import           Test.Hls.FileSystem
 import           Test.Hls.Util
 import           Test.Tasty                         hiding (Timeout)
 import           Test.Tasty.ExpectedFailure
@@ -116,11 +128,26 @@ import           Test.Tasty.HUnit
 import           Test.Tasty.Ingredients.Rerun
 import           Test.Tasty.Runners                 (NumThreads (..))
 
-newtype Log = LogIDEMain IDEMain.Log
+data Log
+  = LogIDEMain IDEMain.Log
+  | LogTestHarness LogTestHarness
 
 instance Pretty Log where
   pretty = \case
-    LogIDEMain log -> pretty log
+    LogIDEMain log     -> pretty log
+    LogTestHarness log -> pretty log
+
+data LogTestHarness
+  = LogTestDir FilePath
+  | LogCleanup
+  | LogNoCleanup
+
+
+instance Pretty LogTestHarness where
+  pretty = \case
+    LogTestDir dir -> "Test Project located in directory:" <+> pretty dir
+    LogCleanup     -> "Cleaned up temporary directory"
+    LogNoCleanup   -> "No cleanup of temporary directory"
 
 -- | Run 'defaultMainWithRerun', limiting each single test case running at most 10 minutes
 defaultTestRunner :: TestTree -> IO ()
@@ -145,6 +172,19 @@ goldenWithHaskellDoc
   -> TestTree
 goldenWithHaskellDoc = goldenWithDoc "haskell"
 
+goldenWithHaskellDocInTmpDir
+  :: Pretty b
+  => Config
+  -> PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithHaskellDocInTmpDir = goldenWithDocInTmpDir "haskell"
+
 goldenWithHaskellAndCaps
   :: Pretty b
   => Config
@@ -167,6 +207,28 @@ goldenWithHaskellAndCaps config clientCaps plugin title testDataDir path desc ex
     act doc
     documentContents doc
 
+goldenWithHaskellAndCapsInTmpDir
+  :: Pretty b
+  => Config
+  -> ClientCapabilities
+  -> PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithHaskellAndCapsInTmpDir config clientCaps plugin title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerAndCapsInTmpDir config plugin clientCaps tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "haskell"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
 goldenWithCabalDoc
   :: Pretty b
   => Config
@@ -202,6 +264,28 @@ goldenWithDoc fileType config plugin title testDataDir path desc ext act =
     act doc
     documentContents doc
 
+goldenWithDocInTmpDir
+  :: Pretty b
+  => T.Text
+  -> Config
+  -> PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithDocInTmpDir fileType config plugin title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerInTmpDir config plugin tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) fileType
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
 -- ------------------------------------------------------------
 -- Helper function for initialising plugins under test
 -- ------------------------------------------------------------
@@ -298,6 +382,76 @@ runSessionWithServerAndCaps config plugin caps fp act = do
   recorder <- pluginTestRecorder
   runSessionWithServer' (plugin recorder) config def caps fp act
 
+runSessionWithServerInTmpDir :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> Session a -> IO a
+runSessionWithServerInTmpDir config plugin tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir' (plugin recorder) config def fullCaps tree act
+
+runSessionWithServerAndCapsInTmpDir :: Pretty b => Config ->  PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> Session a -> IO a
+runSessionWithServerAndCapsInTmpDir config plugin caps tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir' (plugin recorder) config def caps tree act
+
+-- | Host a server, and run a test session on it.
+--
+-- Creates a temporary directory, and materializes the VirtualFileTree
+-- in the temporary directory.
+--
+-- To debug test cases and verify the file system is correctly set up,
+-- you should set the environment variable 'HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1'.
+-- Further, we log the temporary directory location on startup. To view
+-- the logs, set the environment variable 'HLS_TEST_HARNESS_STDERR=1'.
+--
+-- Example invocation to debug test cases:
+--
+-- @
+--   HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP=1 HLS_TEST_HARNESS_STDERR=1 cabal test <plugin-name>
+-- @
+--
+-- Don't forget to use 'TASTY_PATTERN' to debug only a subset of tests.
+--
+-- For plugin test logs, look at the documentation of 'mkPluginTestDescriptor'.
+--
+-- Note: cwd will be shifted into a temporary directory in @Session a@
+runSessionWithServerInTmpDir' ::
+  -- | Plugins to load on the server.
+  --
+  -- For improved logging, make sure these plugins have been initalised with
+  -- the recorder produced by @pluginTestRecorder@.
+  IdePlugins IdeState ->
+  -- | lsp config for the server
+  Config ->
+  -- | config for the test session
+  SessionConfig ->
+  ClientCapabilities ->
+  VirtualFileTree ->
+  Session a ->
+  IO a
+runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
+  (recorder, _) <- initialiseTestRecorder
+    ["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
+
+  -- Do not clean up the temporary directory if this variable is set to anything but '0'.
+  -- Aids debugging.
+  cleanupTempDir <- lookupEnv "HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
+  let runTestInDir = case cleanupTempDir of
+        Just val
+          | val /= "0" -> \action -> do
+            (tempDir, _) <- newTempDir
+            a <- action tempDir
+            logWith recorder Debug $ LogNoCleanup
+            pure a
+
+        _ -> \action -> do
+          a <- withTempDir action
+          logWith recorder Debug $ LogCleanup
+          pure a
+
+  runTestInDir $ \tmpDir -> do
+    logWith recorder Info $ LogTestDir tmpDir
+    _fs <- FS.materialiseVFT tmpDir tree
+    runSessionWithServer' plugins conf sessConf caps tmpDir act
+
 goldenWithHaskellDocFormatter
   :: Pretty b
   => Config
@@ -346,6 +500,54 @@ goldenWithCabalDocFormatter config plugin formatter conf title testDataDir path
     act doc
     documentContents doc
 
+goldenWithHaskellDocFormatterInTmpDir
+  :: Pretty b
+  => Config
+  -> PluginTestDescriptor b -- ^ Formatter plugin to be used
+  -> String -- ^ Name of the formatter to be used
+  -> PluginConfig
+  -> TestName -- ^ Title of the test
+  -> VirtualFileTree -- ^ Virtual representation of the test project
+  -> 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
+goldenWithHaskellDocFormatterInTmpDir config plugin formatter conf title tree path desc ext act =
+  let config' = config { formattingProvider = T.pack formatter , plugins = M.singleton (PluginId $ T.pack formatter) conf }
+  in goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerInTmpDir config' plugin tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "haskell"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
+goldenWithCabalDocFormatterInTmpDir
+  :: Pretty b
+  => Config
+  -> PluginTestDescriptor b -- ^ Formatter plugin to be used
+  -> String -- ^ Name of the formatter to be used
+  -> PluginConfig
+  -> TestName -- ^ Title of the test
+  -> VirtualFileTree -- ^ Virtual representation of the test project
+  -> 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
+goldenWithCabalDocFormatterInTmpDir config plugin formatter conf title tree path desc ext act =
+  let config' = config { cabalFormattingProvider = T.pack formatter , plugins = M.singleton (PluginId $ T.pack formatter) conf }
+  in goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerInTmpDir config' plugin tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "cabal"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
 -- | Restore cwd after running an action
 keepCurrentDirectory :: IO a -> IO a
 keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
@@ -355,6 +557,12 @@ keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
 lock :: Lock
 lock = unsafePerformIO newLock
 
+
+{-# NOINLINE lockForTempDirs #-}
+-- | Never run in parallel
+lockForTempDirs :: Lock
+lockForTempDirs = unsafePerformIO newLock
+
 -- | Host a server, and run a test session on it
 -- Note: cwd will be shifted into @root@ in @Session a@
 runSessionWithServer' ::
@@ -371,7 +579,7 @@ runSessionWithServer' ::
   FilePath ->
   Session a ->
   IO a
-runSessionWithServer' plugins conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
+runSessionWithServer' plugins conf sconf caps root s =  withLock lock $ keepCurrentDirectory $ do
     (inR, inW) <- createPipe
     (outR, outW) <- createPipe