From cb2fd665f29ff078e0060ec7f6b07bdd0a046196 Mon Sep 17 00:00:00 2001 From: shaurya gupta Date: Thu, 3 Sep 2020 06:23:06 +0530 Subject: [PATCH] Use InitializeParams.rootUri for initial session setup (#713) * add rootUri tests * use rootUri in session loader --- exe/Main.hs | 4 +-- src/Development/IDE/LSP/LanguageServer.hs | 4 +-- test/data/rootUri/dirA/Foo.hs | 3 ++ test/data/rootUri/dirA/foo.cabal | 9 ++++++ test/data/rootUri/dirB/Foo.hs | 3 ++ test/data/rootUri/dirB/foo.cabal | 9 ++++++ test/exe/Main.hs | 35 ++++++++++++++++++----- 7 files changed, 56 insertions(+), 11 deletions(-) create mode 100644 test/data/rootUri/dirA/Foo.hs create mode 100644 test/data/rootUri/dirA/foo.cabal create mode 100644 test/data/rootUri/dirB/Foo.hs create mode 100644 test/data/rootUri/dirB/foo.cabal diff --git a/exe/Main.hs b/exe/Main.hs index a253cb72..c85a0e8e 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -96,10 +96,10 @@ main = do t <- offsetTime hPutStrLn stderr "Starting LSP server..." hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig -> do + runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t - sessionLoader <- loadSession dir + sessionLoader <- loadSession $ fromMaybe dir rootPath config <- fromMaybe defaultLspConfig <$> getConfig let options = (defaultIdeOptions sessionLoader) { optReportProgress = clientSupportsProgress caps diff --git a/src/Development/IDE/LSP/LanguageServer.hs b/src/Development/IDE/LSP/LanguageServer.hs index afacc42f..ec124c22 100644 --- a/src/Development/IDE/LSP/LanguageServer.hs +++ b/src/Development/IDE/LSP/LanguageServer.hs @@ -46,7 +46,7 @@ runLanguageServer -> (InitializeRequest -> Either T.Text config) -> (DidChangeConfigurationNotification -> Either T.Text config) -> (IO LspId -> (FromServerMessage -> IO ()) -> VFSHandle -> ClientCapabilities - -> WithProgressFunc -> WithIndefiniteProgressFunc -> IO (Maybe config) -> IO IdeState) + -> WithProgressFunc -> WithIndefiniteProgressFunc -> IO (Maybe config) -> Maybe FilePath -> IO IdeState) -> IO () runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeState = do -- Move stdout to another file descriptor and duplicate stderr @@ -133,7 +133,7 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat handleInit exitClientMsg clearReqId waitForCancel clientMsgChan lspFuncs@LSP.LspFuncs{..} = do ide <- getIdeState getNextReqId sendFunc (makeLSPVFSHandle lspFuncs) clientCapabilities - withProgress withIndefiniteProgress config + withProgress withIndefiniteProgress config rootPath _ <- flip forkFinally (const exitClientMsg) $ forever $ do msg <- readChan clientMsgChan diff --git a/test/data/rootUri/dirA/Foo.hs b/test/data/rootUri/dirA/Foo.hs new file mode 100644 index 00000000..ea4238dc --- /dev/null +++ b/test/data/rootUri/dirA/Foo.hs @@ -0,0 +1,3 @@ +module Foo () where + +foo = () diff --git a/test/data/rootUri/dirA/foo.cabal b/test/data/rootUri/dirA/foo.cabal new file mode 100644 index 00000000..3cdd320a --- /dev/null +++ b/test/data/rootUri/dirA/foo.cabal @@ -0,0 +1,9 @@ +name: foo +version: 1.0.0 +build-type: Simple +cabal-version: >= 1.2 + +library + build-depends: base + exposed-modules: Foo + hs-source-dirs: . diff --git a/test/data/rootUri/dirB/Foo.hs b/test/data/rootUri/dirB/Foo.hs new file mode 100644 index 00000000..ea4238dc --- /dev/null +++ b/test/data/rootUri/dirB/Foo.hs @@ -0,0 +1,3 @@ +module Foo () where + +foo = () diff --git a/test/data/rootUri/dirB/foo.cabal b/test/data/rootUri/dirB/foo.cabal new file mode 100644 index 00000000..3cdd320a --- /dev/null +++ b/test/data/rootUri/dirB/foo.cabal @@ -0,0 +1,9 @@ +name: foo +version: 1.0.0 +build-type: Simple +cabal-version: >= 1.2 + +library + build-depends: base + exposed-modules: Foo + hs-source-dirs: . diff --git a/test/exe/Main.hs b/test/exe/Main.hs index e7fe89c7..82375d5c 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -88,6 +88,7 @@ main = do , benchmarkTests , ifaceTests , bootTests + , rootUriTests ] initializeResponseTests :: TestTree @@ -3113,9 +3114,22 @@ benchmarkTests = , Bench.name e /= "edit" -- the edit experiment does not ever fail ] +-- | checks if we use InitializeParams.rootUri for loading session +rootUriTests :: TestTree +rootUriTests = testCase "use rootUri" . withoutStackEnv . runTest "dirA" "dirB" $ \dir -> do + let bPath = dir "dirB/Foo.hs" + liftIO $ copyTestDataFiles dir "rootUri" + bSource <- liftIO $ readFileUtf8 bPath + _ <- createDoc "Foo.hs" "haskell" bSource + expectNoMoreDiagnostics 0.5 + where + -- similar to run' except we can configure where to start ghcide and session + runTest :: FilePath -> FilePath -> (FilePath -> Session ()) -> IO () + runTest dir1 dir2 s = withTempDir $ \dir -> runInDir' dir dir1 dir2 (s dir) + ---------------------------------------------------------------------- -- Utils - +---------------------------------------------------------------------- testSession :: String -> Session () -> TestTree testSession name = testCase name . run @@ -3174,20 +3188,27 @@ run' :: (FilePath -> Session a) -> IO a run' s = withTempDir $ \dir -> runInDir dir (s dir) runInDir :: FilePath -> Session a -> IO a -runInDir dir s = do - ghcideExe <- locateGhcideExecutable +runInDir dir = runInDir' dir "." "." +-- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root. +runInDir' :: FilePath -> FilePath -> FilePath -> Session a -> IO a +runInDir' dir startExeIn startSessionIn s = do + ghcideExe <- locateGhcideExecutable + let startDir = dir startExeIn + let projDir = dir startSessionIn + + createDirectoryIfMissing True startDir + createDirectoryIfMissing True projDir -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56 -- since the package import test creates "Data/List.hs", which otherwise has no physical home - createDirectoryIfMissing True $ dir ++ "/Data" + createDirectoryIfMissing True $ projDir ++ "/Data" - - let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", dir] + let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", startDir] -- HIE calls getXgdDirectory which assumes that HOME is set. -- Only sets HOME if it wasn't already set. setEnv "HOME" "/homeless-shelter" False let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True } - runSessionWithConfig conf cmd lspTestCaps dir s + runSessionWithConfig conf cmd lspTestCaps projDir s where conf = defaultConfig -- If you uncomment this you can see all logging