Refactor hls-refactor-plugin-tests to use VirtualFileTree

plugins/hls-refactor-plugin/test/Main.hs

@@ -26,17 +26,13 @@
 import           Development.IDE.Plugin.Completions.Types (extendImportCommandId)
 import           Development.IDE.Test
 import           Development.IDE.Types.Location
-import           Development.Shake                        (getDirectoryFilesIO)
 import qualified Language.LSP.Protocol.Lens               as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types              hiding
                                                           (SemanticTokensEdit (_start),
                                                            mkRange)
 import           Language.LSP.Test
-import           System.Directory
 import           System.FilePath
-import qualified System.IO.Extra
-import           System.IO.Extra                          hiding (withTempDir)
 import           System.Time.Extra
 import           Test.Tasty
 import           Test.Tasty.HUnit
@@ -45,6 +41,7 @@
 
 import           Development.IDE.Plugin.CodeAction        (matchRegExMultipleImports)
 import           Test.Hls
+import qualified Test.Hls.FileSystem                      as FS
 
 import qualified Development.IDE.GHC.ExactPrint
 import           Development.IDE.Plugin.CodeAction        (NotInScope (..))
@@ -1849,8 +1846,8 @@
       let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
           after  = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
           cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, B]}}"
       liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
       liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["{-# LANGUAGE PatternSynonyms #-}", "module B where", "pattern Some x = Just x"]
       doc <- createDoc "Test.hs" "haskell" before
       waitForProgressDone
       _ <- waitForDiagnostics
@@ -1886,8 +1883,8 @@
       let before = T.unlines ["module A where", "import B (Foo)", "getFoo :: Foo -> Int", "getFoo x = x.foo"]
           after  = T.unlines ["module A where", "import B (Foo, foo)", "getFoo :: Foo -> Int", "getFoo x = x.foo"]
           cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, B]}}"
       liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
       liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["module B where", "data Foo = Foo { foo :: Int }"]
       doc <- createDoc "Test.hs" "haskell" before
       waitForProgressDone
       _ <- waitForDiagnostics
@@ -1913,9 +1910,9 @@
           before = T.unlines ["{-# LANGUAGE OverloadedRecordDot #-}", "module A where", if qualifiedGhcRecords then "" else "import GHC.Records", "import C (bar)", "spam = bar.foo"]
           after = T.unlines ["{-# LANGUAGE OverloadedRecordDot #-}", "module A where", if qualifiedGhcRecords then "" else "import GHC.Records", "import C (bar)", "import B (Foo(..))", "spam = bar.foo"]
           cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, B, C]}}"
       liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
       liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["module B where", if polymorphicType then "data Foo x = Foo { foo :: x }" else "data Foo = Foo { foo :: Int }"]
       liftIO $ writeFileUTF8 (dir </> "C.hs") $ unlines ["module C where", "import B", "bar = Foo 10" ]
       doc <- createDoc "Test.hs" "haskell" before
       waitForProgressDone
       _ <- waitForDiagnostics
@@ -1938,9 +1935,9 @@
           before = T.unlines ["module C where", "import B", "biz = bar { foo = 100 }"]
           after = T.unlines ["module C where", "import B", "import A (Foo(..))", "biz = bar { foo = 100 }"]
           cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, B, C]}}"
       liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
       liftIO $ writeFileUTF8 (dir </> "A.hs") $ unlines ["module A where", "data Foo = Foo { foo :: Int }"]
       liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["module B where", "import A", "bar = Foo 10" ]
       doc <- createDoc "Test.hs" "haskell" before
       waitForProgressDone
       diags <- waitForDiagnostics
@@ -2000,7 +1997,7 @@
       let before = T.unlines ["module A where", "import Data.Coerce (coerce)", "import Data.Semigroup (Sum)", "bar = coerce (10 :: Int) :: Sum Int"]
           after = T.unlines ["module A where", "import Data.Coerce (coerce)", "import Data.Semigroup (Sum)", "import Data.Semigroup (Sum(..))", "bar = coerce (10 :: Int) :: Sum Int"]
           cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A]}}"
       liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
       doc <- createDoc "Test.hs" "haskell" before
       waitForProgressDone
       _ <- waitForDiagnostics
@@ -4031,40 +4028,29 @@
 testSessionWithExtraFiles prefix name = testCase name . runWithExtraFiles prefix
 
 runWithExtraFiles :: HasCallStack => FilePath -> (FilePath -> Session a) -> IO a
-runWithExtraFiles prefix s = withTempDir $ \dir -> do
-  copyTestDataFiles dir prefix
-  runInDir dir (s dir)
-
-copyTestDataFiles :: HasCallStack => FilePath -> FilePath -> IO ()
-copyTestDataFiles dir prefix = do
-  -- Copy all the test data files to the temporary workspace
-  testDataFiles <- getDirectoryFilesIO ("plugins/hls-refactor-plugin/test/data" </> prefix) ["//*"]
-  for_ testDataFiles $ \f -> do
-    createDirectoryIfMissing True $ dir </> takeDirectory f
-    copyFile ("plugins/hls-refactor-plugin/test/data" </> prefix </> f) (dir </> f)
-
-run :: Session a -> IO a
-run s = run' (const s)
-
-run' :: (FilePath -> Session a) -> IO a
-run' s = withTempDir $ \dir -> runInDir dir (s dir)
-
-runInDir :: FilePath -> Session a -> IO a
-runInDir dir act =
+runWithExtraFiles prefix s =
     runSessionWithTestConfig def
-        { testDirLocation = Left dir
+        { testDirLocation = Right $ mkVirtualFileTreeWithPrefix prefix
         , testPluginDescriptor = refactorPlugin
         , testConfigCaps = lspTestCaps }
-        $ const act
+        s
+
+testDataDir :: FilePath
+testDataDir = "plugins/hls-refactor-plugin/test/data"
+
+mkVirtualFileTreeWithPrefix :: FilePath -> FS.VirtualFileTree
+mkVirtualFileTreeWithPrefix prefix =
+    FS.mkVirtualFileTree testDataDir [FS.copyDir prefix]
+
+run :: Session a -> IO a
+run s = runSessionWithTestConfig def
+    { testDirLocation = Right $ FS.mkVirtualFileTree testDataDir []
+    , testPluginDescriptor = refactorPlugin
+    , testConfigCaps = lspTestCaps }
+    (const s)
 
 lspTestCaps :: ClientCapabilities
 lspTestCaps = fullLatestClientCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
 
 pattern R :: UInt -> UInt -> UInt -> UInt -> Range
 pattern R x y x' y' = Range (Position x y) (Position x' y')
-
--- | Version of 'System.IO.Extra.withTempDir' that canonicalizes the path
--- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
--- @/var@
-withTempDir :: (FilePath -> IO a) -> IO a
-withTempDir f = System.IO.Extra.withTempDir $ (canonicalizePath >=> f)