From 773ec8658ec192435419fa630d9509f0211dbc4b Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 16 Jul 2020 15:26:04 +0100
Subject: [PATCH] Fix wrapper tests by copying to temporary directory

---
 .gitignore                                    |  2 +-
 haskell-language-server.cabal                 |  1 +
 test/utils/Test/Hls/Util.hs                   | 31 ++++++++++++++++++-
 test/wrapper/Main.hs                          | 11 +++----
 test/wrapper/testdata/stack-8.10.1/stack.yaml |  1 +
 test/wrapper/testdata/stack-8.8.3/stack.yaml  |  1 +
 6 files changed, 39 insertions(+), 8 deletions(-)
 create mode 100644 test/wrapper/testdata/stack-8.10.1/stack.yaml
 create mode 100644 test/wrapper/testdata/stack-8.8.3/stack.yaml

diff --git a/.gitignore b/.gitignore
index 395b29dc79..edae27b422 100644
--- a/.gitignore
+++ b/.gitignore
@@ -20,7 +20,7 @@ stack*.yaml.lock
 shake.yaml.lock
 
 # ignore hie.yaml's for testdata
-test/**/*.yaml
+test/testdata/**/hie.yaml
 
 # metadata files on macOS
 .DS_Store
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 46ffe9dc1b..dcd1aa8752 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -217,6 +217,7 @@ common hls-test-utils
                      , lsp-test
                      , stm
                      , tasty-hunit
+                     , temporary
                      , text
                      , transformers
                      , unordered-containers
diff --git a/test/utils/Test/Hls/Util.hs b/test/utils/Test/Hls/Util.hs
index e3dd99a18d..c6b14a6ea1 100644
--- a/test/utils/Test/Hls/Util.hs
+++ b/test/utils/Test/Hls/Util.hs
@@ -15,6 +15,7 @@ module Test.Hls.Util
     , setupBuildToolFiles
     , withFileLogging
     , findExe
+    , withCurrentDirectoryInTmp
   -- , makeRequest
   -- , runIGM
   -- , runIGM'
@@ -46,6 +47,7 @@ import           System.Directory
 import           System.Environment
 import           System.FilePath
 import qualified System.Log.Logger as L
+import           System.IO.Temp
 -- import           Test.Hspec
 import           Test.Hspec.Runner
 import           Test.Hspec.Core.Formatters
@@ -332,6 +334,33 @@ findExeRecursive exe dir = do
 findExe :: String -> IO FilePath
 findExe name = do
   fp <- fmap fromJust $ runMaybeT $
-    MaybeT (findExecutable name) <|> 
+    MaybeT (findExecutable name) <|>
     MaybeT (findExeRecursive name "dist-newstyle")
   makeAbsolute fp
+
+-- | Like 'withCurrentDirectory', but will copy the directory over to the system
+-- temporary directory first to avoid haskell-language-server's source tree from
+-- interfering with the cradle
+withCurrentDirectoryInTmp :: FilePath -> IO a -> IO a
+withCurrentDirectoryInTmp dir f =
+  withTempCopy dir $ \newDir ->
+    withCurrentDirectory newDir f
+
+withTempCopy :: FilePath -> (FilePath -> IO a) -> IO a
+withTempCopy srcDir f = do
+  withSystemTempDirectory "hls-test" $ \newDir -> do
+    copyDir srcDir newDir
+    f newDir
+
+copyDir :: FilePath -> FilePath -> IO ()
+copyDir src dst = do
+  cnts <- listDirectory src
+  forM_ cnts $ \file -> do
+    unless (file `elem` ignored) $ do
+      let srcFp = src </> file
+          dstFp = dst </> file
+      isDir <- doesDirectoryExist srcFp
+      if isDir
+        then createDirectory dstFp >> copyDir srcFp dstFp
+        else copyFile srcFp dstFp
+  where ignored = ["dist", "dist-newstyle", ".stack-work"]
diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs
index ea793e57fd..6f2795a579 100644
--- a/test/wrapper/Main.hs
+++ b/test/wrapper/Main.hs
@@ -3,14 +3,14 @@ import Data.Char
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.HUnit
-import System.Directory
 import System.Process
 
 main :: IO ()
-main = defaultMain $
-  testGroup "haskell-language-server-wrapper" [projectGhcVersionTests]
+main = do
+  flushStackEnvironment
+  defaultMain $
+    testGroup "haskell-language-server-wrapper" [projectGhcVersionTests]
 
---TODO: WAIT ON HIE-BIOS STOP FILES
 projectGhcVersionTests :: TestTree
 projectGhcVersionTests = testGroup "--project-ghc-version"
   [ testCase "stack with ghc 8.10.1" $
@@ -25,10 +25,9 @@ projectGhcVersionTests = testGroup "--project-ghc-version"
 testDir :: FilePath -> String -> Assertion
 testDir dir expectedVer = do
   wrapper <- findExe "haskell-language-server-wrapper"
-  withCurrentDirectory dir $ do
+  withCurrentDirectoryInTmp dir $ do
     actualVer <- trim <$> readProcess wrapper ["--project-ghc-version"] ""
     actualVer @?= expectedVer
 
 trim :: String -> String
 trim = dropWhileEnd isSpace
-
diff --git a/test/wrapper/testdata/stack-8.10.1/stack.yaml b/test/wrapper/testdata/stack-8.10.1/stack.yaml
new file mode 100644
index 0000000000..409e7fe489
--- /dev/null
+++ b/test/wrapper/testdata/stack-8.10.1/stack.yaml
@@ -0,0 +1 @@
+resolver: ghc-8.10.1
diff --git a/test/wrapper/testdata/stack-8.8.3/stack.yaml b/test/wrapper/testdata/stack-8.8.3/stack.yaml
new file mode 100644
index 0000000000..fc8cd8cd8f
--- /dev/null
+++ b/test/wrapper/testdata/stack-8.8.3/stack.yaml
@@ -0,0 +1 @@
+resolver: ghc-8.8.3