Introduce declarative test project definition

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

A sub directory 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. 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,
@@ -105,9 +114,12 @@ import           System.Directory                   (getCurrentDirectory,
                                                      setCurrentDirectory)
 import           System.Environment                 (lookupEnv)
 import           System.FilePath
+import           System.IO.Extra                    (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
@@ -144,6 +156,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 +189,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 (vftTestDataRoot 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 +243,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 (vftTestDataRoot 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 +374,51 @@ 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
+-- 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 lock2 $ do
+  withTempDir $ \tmpDir -> do
+    _fs <- FS.materialiseVFT tmpDir tree
+    runSessionWithServer' plugins conf sessConf caps tmpDir act
+
 goldenWithHaskellDocFormatter
   :: Pretty b
   => PluginTestDescriptor b -- ^ Formatter plugin to be used
@@ -352,6 +463,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 (vftTestDataRoot 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 (vftTestDataRoot 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 +518,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 +544,12 @@ keepCurrentDirectory = bracket getCurrentDirectory setCurrentDirectory . const
 lock :: Lock
 lock = unsafePerformIO newLock
 
+
+{-# NOINLINE lock2 #-}
+-- | Never run in parallel
+lock2 :: Lock
+lock2 = 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 +566,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