From: Luke Lau Date: Sun, 27 May 2018 16:50:12 +0000 (-0400) Subject: Add root directory swapping X-Git-Tag: 0.1.0.0~103 X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=6930c3cb143fb7aca3f14ea865052ab79c386684 Add root directory swapping --- diff --git a/.travis.yml b/.travis.yml index 9e73eaa..03adf0b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,5 +13,11 @@ before_install: - export PATH=$HOME/.local/bin:$PATH - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' +install: + - git clone https://github.com/haskell/haskell-ide-engine.git --recursive + - cd haskell-ide-engine + - stack install + - cd .. + script: - stack --no-terminal --skip-ghc-check test diff --git a/example/Recorded.hs b/example/Recorded.hs index 470bfdb..63ee877 100644 --- a/example/Recorded.hs +++ b/example/Recorded.hs @@ -3,6 +3,6 @@ import System.Directory import System.Environment main = do - [client, server] <- (take 2 <$> getArgs) >>= mapM canonicalizePath - passed <- replay client server + [client, server, dir] <- (take 3 <$> getArgs) >>= mapM canonicalizePath + passed <- replay client server dir putStrLn $ if passed then "Passed" else "Failed" diff --git a/src/Language/Haskell/LSP/Test/Files.hs b/src/Language/Haskell/LSP/Test/Files.hs index 0d79ebd..6557b88 100644 --- a/src/Language/Haskell/LSP/Test/Files.hs +++ b/src/Language/Haskell/LSP/Test/Files.hs @@ -5,11 +5,12 @@ module Language.Haskell.LSP.Test.Files ( swapFiles , FileMap , emptyFileMap + , rootDir ) where import Language.Haskell.LSP.Types hiding ( error ) -import Language.Haskell.LSP.Test.Parsing +import Control.Lens import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as B @@ -28,39 +29,48 @@ type FileMap = Map.Map Uri Uri emptyFileMap :: FileMap emptyFileMap = Map.empty -buildFileMap :: [Uri] -> FileMap -> IO FileMap -buildFileMap uris oldMap = foldM createFile oldMap uris +buildFileMap :: [Uri] -> FilePath -> FilePath -> FileMap -> IO FileMap +buildFileMap uris recBaseDir curBaseDir oldMap = + foldM (createFile recBaseDir curBaseDir) oldMap uris where - createFile map uri = + createFile baseDir curDir map uri = if Map.member uri map then return map else do let fp = fromMaybe (error "Couldn't convert file path") (uriToFilePath uri) + relativeFp = makeRelative baseDir fp + actualFp = curDir relativeFp -- Need to store in a directory inside tmp directory -- otherwise ghc-mod ends up creating one for us - tmpDir <- ( "lsp-test") <$> getTemporaryDirectory - createDirectoryIfMissing False tmpDir + tmpDir <- ( "lsp-test" takeDirectory relativeFp) <$> getTemporaryDirectory + createDirectoryIfMissing True tmpDir - (tmpFp, tmpH) <- openTempFile tmpDir (takeFileName fp) + (tmpFp, tmpH) <- openTempFile tmpDir (takeFileName actualFp) - readFile fp >>= hPutStr tmpH + readFile actualFp >>= hPutStr tmpH tmpUri <- filePathToUri <$> canonicalizePath tmpFp return $ Map.insert uri tmpUri map -swapFiles :: FileMap -> Handle -> IO ([B.ByteString], FileMap) -swapFiles fileMap h = do - msgs <- getAllMessages h +swapFiles :: FileMap -> FilePath -> FilePath -> [B.ByteString] -> IO ([B.ByteString], FileMap) +swapFiles fileMap recBaseDir curBaseDir msgs = do let oldUris = Set.unions $ map extractUris msgs - newMap <- buildFileMap (Set.elems oldUris) fileMap + newMap <- buildFileMap (Set.elems oldUris) recBaseDir curBaseDir fileMap let newMsgs = map (swapUris newMap) msgs return (newMsgs, newMap) +rootDir :: [B.ByteString] -> FilePath +rootDir msgs = case decode (head msgs) :: Maybe InitializeRequest of + Just req -> fromMaybe (error "Couldn't convert root dir") $ do + rootUri <- req ^. params . rootUri + uriToFilePath rootUri + Nothing -> error "Couldn't find root dir" + extractUris :: B.ByteString -> Set.Set Uri extractUris msgs = case decode msgs :: Maybe Object of diff --git a/src/Language/Haskell/LSP/Test/Recorded.hs b/src/Language/Haskell/LSP/Test/Recorded.hs index cf20c67..c92664c 100644 --- a/src/Language/Haskell/LSP/Test/Recorded.hs +++ b/src/Language/Haskell/LSP/Test/Recorded.hs @@ -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 diff --git a/test/Test.hs b/test/Test.hs index 986b4c5..2851427 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -6,6 +6,7 @@ main = hspec $ do it "passes a test" $ do replay "test/recordings/renamePass/client.log" "test/recordings/renamePass/server.log" + "test/recordings/renamePass" `shouldReturn` True -- it "fails a test" $ -- replay "test/recordings/documentSymbolFail/client.log" diff --git a/test/files/simple.hs b/test/recordings/renamePass/Desktop/simple.hs similarity index 100% rename from test/files/simple.hs rename to test/recordings/renamePass/Desktop/simple.hs