Introduce declarative test project definition

Test data is currently often in some 'testdata' directory in 'test/'.
It can easily get quite messy with many files.
Especially since 'lsp-test' should load only exactly what is needed to
speed up tests and avoid test flakiness.

A subdirectory per test file is quite overkill and increases the
required boilerplate to write tests.

Thus, we introduce a declarative test project specification that runs
lsp-test in a temporary directory. The first advantage is that we can load
only exactly what we need, and create more accurate projects.

Author: fendor

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

@@ -20,17 +20,26 @@ module Test.Hls
     defaultTestRunner,
     goldenGitDiff,
     goldenWithHaskellDoc,
+    goldenWithHaskellDocInTmpDir,
     goldenWithHaskellAndCaps,
+    goldenWithHaskellAndCapsInTmpDir,
     goldenWithCabalDoc,
     goldenWithHaskellDocFormatter,
+    goldenWithHaskellDocFormatterInTmpDir,
     goldenWithCabalDocFormatter,
+    goldenWithCabalDocFormatterInTmpDir,
     def,
     -- * Running HLS for integration tests
     runSessionWithServer,
     runSessionWithServerAndCaps,
     runSessionWithServerFormatter,
     runSessionWithCabalServerFormatter,
+    runSessionWithServerInTmpDir,
+    runSessionWithServerAndCapsInTmpDir,
+    runSessionWithServerFormatterInTmpDir,
+    runSessionWithCabalServerFormatterInTmpDir,
     runSessionWithServer',
+    runSessionWithServerInTmpDir',
     -- * Helpful re-exports
     PluginDescriptor,
     IdeState,
@@ -90,11 +99,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 +116,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 +130,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 ()
@@ -144,6 +173,18 @@ goldenWithHaskellDoc
   -> TestTree
 goldenWithHaskellDoc = goldenWithDoc "haskell"
 
+goldenWithHaskellDocInTmpDir
+  :: Pretty b
+  => PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithHaskellDocInTmpDir = goldenWithDocInTmpDir "haskell"
+
 goldenWithHaskellAndCaps
   :: Pretty b
   => ClientCapabilities
@@ -165,6 +206,27 @@ goldenWithHaskellAndCaps clientCaps plugin title testDataDir path desc ext act =
     act doc
     documentContents doc
 
+goldenWithHaskellAndCapsInTmpDir
+  :: Pretty b
+  => ClientCapabilities
+  -> PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithHaskellAndCapsInTmpDir clientCaps plugin title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerAndCapsInTmpDir plugin clientCaps tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "haskell"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
 goldenWithCabalDoc
   :: Pretty b
   => PluginTestDescriptor b
@@ -198,6 +260,27 @@ goldenWithDoc fileType plugin title testDataDir path desc ext act =
     act doc
     documentContents doc
 
+goldenWithDocInTmpDir
+  :: Pretty b
+  => T.Text
+  -> PluginTestDescriptor b
+  -> TestName
+  -> VirtualFileTree
+  -> FilePath
+  -> FilePath
+  -> FilePath
+  -> (TextDocumentIdentifier -> Session ())
+  -> TestTree
+goldenWithDocInTmpDir fileType plugin title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerInTmpDir 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
 -- ------------------------------------------------------------
@@ -308,6 +391,90 @@ runSessionWithServerFormatter plugin formatter conf fp act = do
     fp
     act
 
+runSessionWithServerInTmpDir :: Pretty b => PluginTestDescriptor b -> VirtualFileTree -> Session a -> IO a
+runSessionWithServerInTmpDir plugin tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir' (plugin recorder) def def fullCaps tree act
+
+runSessionWithServerAndCapsInTmpDir :: Pretty b => PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> Session a -> IO a
+runSessionWithServerAndCapsInTmpDir plugin caps tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir' (plugin recorder) def def caps tree act
+
+runSessionWithServerFormatterInTmpDir :: Pretty b => PluginTestDescriptor b -> String -> PluginConfig ->  VirtualFileTree -> Session a -> IO a
+runSessionWithServerFormatterInTmpDir plugin formatter conf tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir'
+    (plugin recorder)
+    def
+      { formattingProvider = T.pack formatter
+      , plugins = M.singleton (PluginId $ T.pack formatter) conf
+      }
+    def
+    fullCaps
+    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
   => PluginTestDescriptor b -- ^ Formatter plugin to be used
@@ -352,6 +519,50 @@ goldenWithCabalDocFormatter plugin formatter conf title testDataDir path desc ex
     act doc
     documentContents doc
 
+goldenWithHaskellDocFormatterInTmpDir
+  :: Pretty b
+  => 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 plugin formatter conf title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithServerFormatterInTmpDir plugin formatter conf tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "haskell"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
+goldenWithCabalDocFormatterInTmpDir
+  :: Pretty b
+  => 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 plugin formatter conf title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
+  $ runSessionWithCabalServerFormatterInTmpDir plugin formatter conf tree
+  $ TL.encodeUtf8 . TL.fromStrict
+  <$> do
+    doc <- openDoc (path <.> ext) "cabal"
+    void waitForBuildQueue
+    act doc
+    documentContents doc
+
 runSessionWithCabalServerFormatter :: Pretty b => PluginTestDescriptor b -> String -> PluginConfig -> FilePath -> Session a -> IO a
 runSessionWithCabalServerFormatter plugin formatter conf fp act = do
   recorder <- pluginTestRecorder
@@ -363,7 +574,22 @@ runSessionWithCabalServerFormatter plugin formatter conf fp act = do
       }
     def
     fullCaps
-    fp act
+    fp
+    act
+
+runSessionWithCabalServerFormatterInTmpDir :: Pretty b => PluginTestDescriptor b -> String -> PluginConfig -> VirtualFileTree -> Session a -> IO a
+runSessionWithCabalServerFormatterInTmpDir plugin formatter conf tree act = do
+  recorder <- pluginTestRecorder
+  runSessionWithServerInTmpDir'
+    (plugin recorder)
+    def
+      { cabalFormattingProvider = T.pack formatter
+      , plugins = M.singleton (PluginId $ T.pack formatter) conf
+      }
+    def
+    fullCaps
+    tree
+    act
 
 -- | Restore cwd after running an action
 keepCurrentDirectory :: IO a -> IO a
@@ -374,6 +600,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' ::
@@ -390,7 +622,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