Skip to content

Commit f201cda

Browse files
authored
Use InitializeParams.rootUri for initial session setup (haskell/ghcide#713)
* add rootUri tests * use rootUri in session loader
1 parent 4507836 commit f201cda

File tree

7 files changed

+55
-10
lines changed

7 files changed

+55
-10
lines changed

ghcide/exe/Main.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -96,10 +96,10 @@ main = do
9696
t <- offsetTime
9797
hPutStrLn stderr "Starting LSP server..."
9898
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
99-
runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig -> do
99+
runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do
100100
t <- t
101101
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
102-
sessionLoader <- loadSession dir
102+
sessionLoader <- loadSession $ fromMaybe dir rootPath
103103
config <- fromMaybe defaultLspConfig <$> getConfig
104104
let options = (defaultIdeOptions sessionLoader)
105105
{ optReportProgress = clientSupportsProgress caps

ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ runLanguageServer
4646
-> (InitializeRequest -> Either T.Text config)
4747
-> (DidChangeConfigurationNotification -> Either T.Text config)
4848
-> (IO LspId -> (FromServerMessage -> IO ()) -> VFSHandle -> ClientCapabilities
49-
-> WithProgressFunc -> WithIndefiniteProgressFunc -> IO (Maybe config) -> IO IdeState)
49+
-> WithProgressFunc -> WithIndefiniteProgressFunc -> IO (Maybe config) -> Maybe FilePath -> IO IdeState)
5050
-> IO ()
5151
runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeState = do
5252
-- Move stdout to another file descriptor and duplicate stderr
@@ -133,7 +133,7 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
133133
handleInit exitClientMsg clearReqId waitForCancel clientMsgChan lspFuncs@LSP.LspFuncs{..} = do
134134

135135
ide <- getIdeState getNextReqId sendFunc (makeLSPVFSHandle lspFuncs) clientCapabilities
136-
withProgress withIndefiniteProgress config
136+
withProgress withIndefiniteProgress config rootPath
137137

138138
_ <- flip forkFinally (const exitClientMsg) $ forever $ do
139139
msg <- readChan clientMsgChan

ghcide/test/data/rootUri/dirA/Foo.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module Foo () where
2+
3+
foo = ()
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
name: foo
2+
version: 1.0.0
3+
build-type: Simple
4+
cabal-version: >= 1.2
5+
6+
library
7+
build-depends: base
8+
exposed-modules: Foo
9+
hs-source-dirs: .

ghcide/test/data/rootUri/dirB/Foo.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module Foo () where
2+
3+
foo = ()
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
name: foo
2+
version: 1.0.0
3+
build-type: Simple
4+
cabal-version: >= 1.2
5+
6+
library
7+
build-depends: base
8+
exposed-modules: Foo
9+
hs-source-dirs: .

ghcide/test/exe/Main.hs

Lines changed: 27 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,7 @@ main = do
8888
, benchmarkTests
8989
, ifaceTests
9090
, bootTests
91+
, rootUriTests
9192
]
9293

9394
initializeResponseTests :: TestTree
@@ -3113,9 +3114,22 @@ benchmarkTests =
31133114
, Bench.name e /= "edit" -- the edit experiment does not ever fail
31143115
]
31153116

3117+
-- | checks if we use InitializeParams.rootUri for loading session
3118+
rootUriTests :: TestTree
3119+
rootUriTests = testCase "use rootUri" . withoutStackEnv . runTest "dirA" "dirB" $ \dir -> do
3120+
let bPath = dir </> "dirB/Foo.hs"
3121+
liftIO $ copyTestDataFiles dir "rootUri"
3122+
bSource <- liftIO $ readFileUtf8 bPath
3123+
_ <- createDoc "Foo.hs" "haskell" bSource
3124+
expectNoMoreDiagnostics 0.5
3125+
where
3126+
-- similar to run' except we can configure where to start ghcide and session
3127+
runTest :: FilePath -> FilePath -> (FilePath -> Session ()) -> IO ()
3128+
runTest dir1 dir2 s = withTempDir $ \dir -> runInDir' dir dir1 dir2 (s dir)
3129+
31163130
----------------------------------------------------------------------
31173131
-- Utils
3118-
3132+
----------------------------------------------------------------------
31193133

31203134
testSession :: String -> Session () -> TestTree
31213135
testSession name = testCase name . run
@@ -3174,20 +3188,27 @@ run' :: (FilePath -> Session a) -> IO a
31743188
run' s = withTempDir $ \dir -> runInDir dir (s dir)
31753189

31763190
runInDir :: FilePath -> Session a -> IO a
3177-
runInDir dir s = do
3191+
runInDir dir = runInDir' dir "." "."
3192+
3193+
-- | Takes a directory as well as relative paths to where we should launch the executable as well as the session root.
3194+
runInDir' :: FilePath -> FilePath -> FilePath -> Session a -> IO a
3195+
runInDir' dir startExeIn startSessionIn s = do
31783196
ghcideExe <- locateGhcideExecutable
3197+
let startDir = dir </> startExeIn
3198+
let projDir = dir </> startSessionIn
31793199

3200+
createDirectoryIfMissing True startDir
3201+
createDirectoryIfMissing True projDir
31803202
-- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56
31813203
-- since the package import test creates "Data/List.hs", which otherwise has no physical home
3182-
createDirectoryIfMissing True $ dir ++ "/Data"
3183-
3204+
createDirectoryIfMissing True $ projDir ++ "/Data"
31843205

3185-
let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", dir]
3206+
let cmd = unwords [ghcideExe, "--lsp", "--test", "--cwd", startDir]
31863207
-- HIE calls getXgdDirectory which assumes that HOME is set.
31873208
-- Only sets HOME if it wasn't already set.
31883209
setEnv "HOME" "/homeless-shelter" False
31893210
let lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities $ Just True }
3190-
runSessionWithConfig conf cmd lspTestCaps dir s
3211+
runSessionWithConfig conf cmd lspTestCaps projDir s
31913212
where
31923213
conf = defaultConfig
31933214
-- If you uncomment this you can see all logging

0 commit comments

Comments
 (0)