Fix wrapper tests by copying to temporary directory

Author: lukel97

.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

haskell-language-server.cabal

@@ -217,6 +217,7 @@ common hls-test-utils
                      , lsp-test
                      , stm
                      , tasty-hunit
+                     , temporary
                      , text
                      , transformers
                      , unordered-containers

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"]

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
-

test/wrapper/testdata/stack-8.10.1/stack.yaml

@@ -0,0 +1 @@
+resolver: ghc-8.10.1

test/wrapper/testdata/stack-8.8.3/stack.yaml

@@ -0,0 +1 @@
+resolver: ghc-8.8.3