Use InitializeParams.rootUri for initial session setup (#713)

* add rootUri tests

* use rootUri in session loader

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

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

test/data/rootUri/dirA/Foo.hs

@@ -0,0 +1,3 @@
+module Foo () where
+
+foo = ()

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: .

test/data/rootUri/dirB/Foo.hs

@@ -0,0 +1,3 @@
+module Foo () where
+
+foo = ()

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: .

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
+runInDir dir = runInDir' dir "." "."
-  ghcideExe <- locateGhcideExecutable
 
+-- | 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", startDir]
-  let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", dir]
   -- 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