Add root directory swapping
[lsp-test.git] / src / Language / Haskell / LSP / Test / Recorded.hs
index cf20c67a2deff652c80b36c70ef5e94756b2f933..c92664c977deb811361f206dff29e37fe4e023d0 100644 (file)
@@ -30,8 +30,9 @@ import           Language.Haskell.LSP.Test.Parsing
 replay
   :: FilePath -- ^ The client output to replay to the server.
   -> FilePath -- ^ The expected response from the server.
+  -> FilePath -- ^ The root directory of the project
   -> IO Bool
-replay cfp sfp = do
+replay cfp sfp curRootDir = do
 
   -- need to keep hold of current directory since haskell-lsp changes it
   prevDir <- getCurrentDirectory
@@ -56,14 +57,18 @@ replay cfp sfp = do
   null         <- openFile "/dev/null" WriteMode
 
 
-  (clientMsgs, fileMap) <- swapFiles emptyFileMap clientRecIn
+  unswappedClientMsgs <- getAllMessages clientRecIn
+
+  let recRootDir = rootDir unswappedClientMsgs
+  
+  (clientMsgs, fileMap) <- swapFiles emptyFileMap recRootDir curRootDir unswappedClientMsgs
 
   tmpDir <- getTemporaryDirectory
   (_, mappedClientRecIn) <- openTempFile tmpDir "clientRecInMapped"
   mapM_ (B.hPut mappedClientRecIn . addHeader) clientMsgs
   hSeek mappedClientRecIn AbsoluteSeek 0
 
-  (expectedMsgs, _) <- swapFiles fileMap serverRecIn
+  (expectedMsgs, _) <- swapFiles fileMap recRootDir curRootDir =<< getAllMessages serverRecIn
 
   -- listen to server
   forkIO $ runReaderT (listenServer expectedMsgs serverOut semas) didPass