Soulomoon/remove cache dir in hls test utils

ghcide/test/exe/Config.hs

@@ -40,5 +40,13 @@ testWithDummyPluginEmpty caseName = testWithDummyPlugin caseName $ mkIdeTestFs [
 testWithDummyPluginEmpty' :: String -> (FileSystem -> Session ()) -> TestTree
 testWithDummyPluginEmpty' caseName = testWithDummyPlugin' caseName $ mkIdeTestFs []
 
+runWithExtraFiles :: String -> (FileSystem -> Session a) -> IO a
+runWithExtraFiles dirName action = do
+    let vfs = mkIdeTestFs [FS.copyDir dirName]
+    runWithDummyPlugin' vfs action
+
+testWithExtraFiles :: String -> String -> (FileSystem -> Session ()) -> TestTree
+testWithExtraFiles testName dirName action = testCase testName $ runWithExtraFiles dirName action
+
 pattern R :: UInt -> UInt -> UInt -> UInt -> Range
 pattern R x y x' y' = Range (Position x y) (Position x' y')

ghcide/test/exe/IfaceTests.hs

@@ -1,5 +1,6 @@
 module IfaceTests (tests) where
 
+import           Config
 import           Control.Monad.IO.Class        (liftIO)
 import qualified Data.Text                     as T
 import           Development.IDE.GHC.Util
@@ -17,9 +18,9 @@ import           Language.LSP.Test
 import           System.Directory
 import           System.FilePath
 import           System.IO.Extra               hiding (withTempDir)
+import           Test.Hls.FileSystem           (toAbsFp)
 import           Test.Tasty
 import           Test.Tasty.HUnit
-import           TestUtils
 
 tests :: TestTree
 tests = testGroup "Interface loading tests"
@@ -33,10 +34,10 @@ tests = testGroup "Interface loading tests"
 
 -- | test that TH reevaluates across interfaces
 ifaceTHTest :: TestTree
-ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do
-    let aPath = dir </> "THA.hs"
-        bPath = dir </> "THB.hs"
-        cPath = dir </> "THC.hs"
+ifaceTHTest = testWithExtraFiles "iface-th-test" "TH" $ \dir -> do
+    let aPath = dir `toAbsFp` "THA.hs"
+        bPath = dir `toAbsFp` "THB.hs"
+        cPath = dir `toAbsFp` "THC.hs"
 
     aSource <- liftIO $ readFileUtf8 aPath -- [TH] a :: ()
     _bSource <- liftIO $ readFileUtf8 bPath -- a :: ()
@@ -55,10 +56,10 @@ ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do
     closeDoc cdoc
 
 ifaceErrorTest :: TestTree
-ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \dir -> do
+ifaceErrorTest = testWithExtraFiles "iface-error-test-1" "recomp" $ \dir -> do
     configureCheckProject True
-    let bPath = dir </> "B.hs"
-        pPath = dir </> "P.hs"
+    let bPath = dir `toAbsFp` "B.hs"
+        pPath = dir `toAbsFp` "P.hs"
 
     bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
     pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int
@@ -104,9 +105,9 @@ ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \d
     expectNoMoreDiagnostics 2
 
 ifaceErrorTest2 :: TestTree
-ifaceErrorTest2 = testCase "iface-error-test-2" $ runWithExtraFiles "recomp" $ \dir -> do
-    let bPath = dir </> "B.hs"
-        pPath = dir </> "P.hs"
+ifaceErrorTest2 = testWithExtraFiles "iface-error-test-2" "recomp" $ \dir -> do
+    let bPath = dir `toAbsFp` "B.hs"
+        pPath = dir `toAbsFp` "P.hs"
 
     bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
     pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int
@@ -138,9 +139,9 @@ ifaceErrorTest2 = testCase "iface-error-test-2" $ runWithExtraFiles "recomp" $ \
     expectNoMoreDiagnostics 2
 
 ifaceErrorTest3 :: TestTree
-ifaceErrorTest3 = testCase "iface-error-test-3" $ runWithExtraFiles "recomp" $ \dir -> do
-    let bPath = dir </> "B.hs"
-        pPath = dir </> "P.hs"
+ifaceErrorTest3 = testWithExtraFiles "iface-error-test-3" "recomp" $ \dir -> do
+    let bPath = dir `toAbsFp` "B.hs"
+        pPath = dir `toAbsFp` "P.hs"
 
     bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
     pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int

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

@@ -67,7 +67,7 @@ import           Control.Concurrent.Async           (async, cancel, wait)
 import           Control.Concurrent.Extra
 import           Control.Exception.Safe
 import           Control.Lens.Extras                (is)
-import           Control.Monad                      (guard, unless, void)
+import           Control.Monad                      (guard, unless, void, when)
 import           Control.Monad.Extra                (forM)
 import           Control.Monad.IO.Class
 import           Data.Aeson                         (Result (Success),
@@ -106,9 +106,12 @@ import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types        hiding (Null)
 import           Language.LSP.Test
 import           Prelude                            hiding (log)
-import           System.Directory                   (createDirectoryIfMissing,
+import           System.Directory                   (canonicalizePath,
+                                                     createDirectoryIfMissing,
+                                                     doesDirectoryExist,
                                                      getCurrentDirectory,
                                                      getTemporaryDirectory,
+                                                     removeDirectoryRecursive,
                                                      setCurrentDirectory)
 import           System.Environment                 (lookupEnv, setEnv)
 import           System.FilePath
@@ -451,7 +454,8 @@ runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock
                 logWith recorder Debug LogCleanup
                 pure a
 
-    runTestInDir $ \tmpDir -> do
+    runTestInDir $ \tmpDir' -> do
+        tmpDir <- canonicalizePath tmpDir'
         logWith recorder Info $ LogTestDir tmpDir
         fs <- FS.materialiseVFT tmpDir tree
         runSessionWithServer' plugins conf sessConf caps tmpDir (act fs)
@@ -483,7 +487,11 @@ setupTestEnvironment = do
   tmpDirRoot <- getTemporaryDirectory
   let testRoot = tmpDirRoot </> "hls-test-root"
       testCacheDir = testRoot </> ".cache"
+  -- If the cache directory already exists, delete it and its contents
+  cacheDirExists <- doesDirectoryExist testCacheDir
+  when cacheDirExists $ removeDirectoryRecursive testCacheDir
   createDirectoryIfMissing True testCacheDir
+  -- cleanup the cache dir
   setEnv "XDG_CACHE_HOME" testCacheDir
   pure testRoot
 

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

@@ -128,8 +128,7 @@ materialise rootDir' fileTree testDataDir' = do
 --
 -- File references in 'virtualFileTree' are resolved relative to the @vftOriginalRoot@.
 materialiseVFT :: FilePath -> VirtualFileTree -> IO FileSystem
-materialiseVFT root fs =
-  materialise root (vftTree fs) (vftOriginalRoot fs)
+materialiseVFT root fs = materialise root (vftTree fs) (vftOriginalRoot fs)
 
 -- ----------------------------------------------------------------------------
 -- Test definition helpers