6363import Control.Applicative.Combinators
6464import Control.Concurrent.Async (async , cancel , wait )
6565import Control.Concurrent.Extra
66- import Control.Exception.Base
66+ import Control.Exception.Safe
6767import Control.Lens.Extras (is )
68- import Control.Monad (guard , unless , void )
68+ import Control.Monad (guard , unless , void , when )
6969import Control.Monad.Extra (forM )
7070import Control.Monad.IO.Class
7171import Data.Aeson (Result (Success ),
@@ -107,10 +107,12 @@ import Language.LSP.Protocol.Types hiding (Null)
107107import Language.LSP.Test
108108import Prelude hiding (log )
109109import System.Directory (getCurrentDirectory ,
110- setCurrentDirectory )
111- import System.Environment (lookupEnv )
110+ getTemporaryDirectory ,
111+ setCurrentDirectory ,
112+ createDirectoryIfMissing )
113+ import System.Environment (lookupEnv , setEnv )
112114import System.FilePath
113- import System.IO.Extra (newTempDir , withTempDir )
115+ import System.IO.Extra (newTempDirWithin )
114116import System.IO.Unsafe (unsafePerformIO )
115117import System.Process.Extra (createPipe )
116118import System.Time.Extra
@@ -423,22 +425,24 @@ runSessionWithServerInTmpDir' ::
423425 Session a ->
424426 IO a
425427runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
428+ testRoot <- setupTestEnvironment
426429 (recorder, _) <- initialiseTestRecorder
427430 [" LSP_TEST_LOG_STDERR" , " HLS_TEST_HARNESS_STDERR" , " HLS_TEST_LOG_STDERR" ]
428431
429432 -- Do not clean up the temporary directory if this variable is set to anything but '0'.
430433 -- Aids debugging.
431434 cleanupTempDir <- lookupEnv " HLS_TEST_HARNESS_NO_TESTDIR_CLEANUP"
432- let runTestInDir = case cleanupTempDir of
435+ let runTestInDir action = case cleanupTempDir of
433436 Just val
434- | val /= " 0" -> \ action -> do
435- (tempDir, _) <- newTempDir
437+ | val /= " 0" -> do
438+ (tempDir, _) <- newTempDirWithin testRoot
436439 a <- action tempDir
437440 logWith recorder Debug LogNoCleanup
438441 pure a
439442
440- _ -> \ action -> do
441- a <- withTempDir action
443+ _ -> do
444+ (tempDir, cleanup) <- newTempDirWithin testRoot
445+ a <- action tempDir `finally` cleanup
442446 logWith recorder Debug LogCleanup
443447 pure a
444448
@@ -447,6 +451,26 @@ runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = withLock loc
447451 _fs <- FS. materialiseVFT tmpDir tree
448452 runSessionWithServer' plugins conf sessConf caps tmpDir act
449453
454+ -- | Setup the test environment for isolated tests.
455+ --
456+ -- This creates a directory in the temporary directory that will be
457+ -- reused for running isolated tests.
458+ -- It returns the root to the testing directory that tests should use.
459+ -- This directory is not fully cleaned between reruns.
460+ -- However, it is totally safe to delete the directory between runs.
461+ --
462+ -- Additionally, this overwrites the 'XDG_CACHE_HOME' variable to isolate
463+ -- the tests from existing caches. 'hie-bios' and 'ghcide' honour the
464+ -- 'XDG_CACHE_HOME' environment variable and generate their caches there.
465+ setupTestEnvironment :: IO FilePath
466+ setupTestEnvironment = do
467+ tmpDirRoot <- getTemporaryDirectory
468+ let testRoot = tmpDirRoot </> " hls-test-root"
469+ testCacheDir = testRoot </> " .cache"
470+ createDirectoryIfMissing False testRoot
471+ createDirectoryIfMissing False testCacheDir
472+ setEnv " XDG_CACHE_HOME" testCacheDir
473+ pure testRoot
450474goldenWithHaskellDocFormatter
451475 :: Pretty b
452476 => Config
0 commit comments