diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for lsp-test +## 0.17.1.0 -- 2024-06-06 + +- Add helpers for testing inlay hints. + ## 0.17.0.2 - Support for newer versions of dependencies. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ ```haskell import Language.LSP.Test -main = runSession "hie" fullCaps "proj/dir" $ do +main = runSession "hie" fullLatestClientCaps "proj/dir" $ do doc <- openDoc "Foo.hs" "haskell" skipMany anyNotification symbols <- getDocumentSymbols doc @@ -19,7 +19,7 @@ ### Unit tests with HSpec ```haskell describe "diagnostics" $ - it "report errors" $ runSession "hie" fullCaps "test/data" $ do + it "report errors" $ runSession "hie" fullLatestClientCaps "test/data" $ do openDoc "Error.hs" "haskell" [diag] <- waitForDiagnosticsSource "ghcmod" liftIO $ do diff --git a/bench/SimpleBench.hs b/bench/SimpleBench.hs --- a/bench/SimpleBench.hs +++ b/bench/SimpleBench.hs @@ -56,7 +56,7 @@ i <- newIORef (0 :: Integer) - Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do + Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullLatestClientCaps "." $ do start <- liftIO offsetTime replicateM_ n $ do v <- liftIO $ readIORef i diff --git a/example/Test.hs b/example/Test.hs --- a/example/Test.hs +++ b/example/Test.hs @@ -7,7 +7,7 @@ import Language.LSP.Test main :: IO () -main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do +main = runSession "lsp-demo-reactor-server" fullLatestClientCaps "test/data/" $ do doc <- openDoc "Rename.hs" "haskell" -- Use your favourite favourite combinators. diff --git a/func-test/FuncTest.hs b/func-test/FuncTest.hs --- a/func-test/FuncTest.hs +++ b/func-test/FuncTest.hs @@ -83,7 +83,7 @@ updater $ ProgressAmount (Just 75) (Just "step3") liftIO $ waitBarrier b3 - runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null -- Wait until we have seen a begin messsage. This means that the token setup @@ -144,7 +144,7 @@ -- Wait around to be cancelled, set the MVar only if we are liftIO $ threadDelay (5 * 1000000) `Control.Exception.catch` (\(e :: ProgressCancelledException) -> modifyMVar_ wasCancelled (\_ -> pure True)) - runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do Test.sendRequest (SMethod_CustomMethod (Proxy @"something")) J.Null -- Wait until we have created the progress so the updates will be sent individually @@ -190,7 +190,7 @@ takeMVar killVar Control.Exception.throwIO AsyncCancelled - runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do -- First make sure that we get a $/progress begin notification skipManyTill Test.anyMessage $ do x <- Test.message SMethod_Progress @@ -235,7 +235,7 @@ updater $ ProgressAmount (Just 75) (Just "step3") liftIO $ waitBarrier b3 - runSessionWithServer logger definition Test.defaultConfig Test.fullCaps "." $ do + runSessionWithServer logger definition Test.defaultConfig Test.fullLatestClientCaps "." $ do Test.sendRequest SMethod_TextDocumentCodeLens (CodeLensParams (Just $ ProgressToken $ InR "hello") Nothing (TextDocumentIdentifier $ Uri ".")) -- First make sure that we get a $/progress begin notification @@ -318,7 +318,7 @@ ps = DidChangeWorkspaceFoldersParams ev in Test.sendNotification SMethod_WorkspaceDidChangeWorkspaceFolders ps - runSessionWithServer logger definition config Test.fullCaps "." $ do + runSessionWithServer logger definition config Test.fullLatestClientCaps "." $ do changeFolders [wf1] [] changeFolders [wf2] [wf1] diff --git a/lsp-test.cabal b/lsp-test.cabal --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: lsp-test -version: 0.17.0.2 +version: 0.17.1.0 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against @@ -55,7 +55,7 @@ , co-log-core ^>=0.3 , conduit ^>=1.3 , conduit-parse ^>=0.2 - , containers ^>=0.6 + , containers >=0.6 && < 0.8 , data-default ^>=0.7 , Diff >=0.4 && <0.6 , directory ^>=1.3 @@ -63,10 +63,10 @@ , extra ^>=1.7 , filepath >=1.4 && < 1.6 , Glob >=0.9 && <0.11 - , lens >=5.1 && <5.3 + , lens >=5.1 && <5.4 , lens-aeson ^>=1.2 - , lsp ^>=2.6 - , lsp-types ^>=2.2 + , lsp ^>=2.7 + , lsp-types ^>=2.3 , mtl >=2.2 && <2.4 , parser-combinators ^>=1.3 , process ^>=1.6 diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs --- a/src/Language/LSP/Test.hs +++ b/src/Language/LSP/Test.hs @@ -30,7 +30,7 @@ -- ** Config SessionConfig (..), defaultConfig, - C.fullCaps, + C.fullLatestClientCaps, -- ** Exceptions module Language.LSP.Test.Exceptions, @@ -124,6 +124,11 @@ getAndResolveCodeLenses, resolveCodeLens, + -- ** Inlay Hints + getInlayHints, + getAndResolveInlayHints, + resolveInlayHint, + -- ** Call hierarchy prepareCallHierarchy, incomingCalls, @@ -176,7 +181,7 @@ {- | Starts a new session. - > runSession "hie" fullCaps "path/to/root/dir" $ do + > runSession "hie" fullLatestClientCaps "path/to/root/dir" $ do > doc <- openDoc "Desktop/simple.hs" "haskell" > diags <- waitForDiagnostics > let pos = Position 12 5 @@ -238,7 +243,7 @@ > (houtRead, houtWrite) <- createPipe > > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition - > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do + > runSessionWithHandles hinWrite houtRead defaultConfig fullLatestClientCaps "." $ do > -- ... -} runSessionWithHandles :: @@ -278,19 +283,20 @@ let initializeParams = InitializeParams - Nothing - -- Narrowing to Int32 here, but it's unlikely that a PID will - -- be outside the range - (InL $ fromIntegral pid) - (Just lspTestClientInfo) - (Just $ T.pack absRootDir) - Nothing - (InL $ filePathToUri absRootDir) - caps - -- TODO: make this configurable? - (Just $ Object $ lspConfig config') - (Just TraceValue_Off) - (fmap InL $ initialWorkspaceFolders config) + { _workDoneToken = Nothing + , -- Narrowing to Int32 here, but it's unlikely that a PID will + -- be outside the range + _processId = InL $ fromIntegral pid + , _clientInfo = Just lspTestClientInfo + , _locale = Nothing + , _rootPath = Just (InL $ T.pack absRootDir) + , _rootUri = InL $ filePathToUri absRootDir + , _capabilities = caps + , -- TODO: make this configurable? + _initializationOptions = Just $ Object $ lspConfig config' + , _trace = Just TraceValue_Off + , _workspaceFolders = InL <$> initialWorkspaceFolders config + } runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do -- Wrap the session around initialize and shutdown calls initReqId <- sendRequest SMethod_Initialize initializeParams @@ -668,7 +674,7 @@ Right (InL xs) -> return (Left xs) Right (InR (InL xs)) -> return (Right xs) Right (InR (InR _)) -> return (Right []) - Left err -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) err) + Left err -> throw (UnexpectedResponseError (fromJust rspLid) err) -- | Returns the code actions in the specified range. getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction] @@ -679,7 +685,7 @@ case rsp ^. L.result of Right (InL xs) -> return xs Right (InR _) -> return [] - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (fromJust $ rsp ^. L.id) error) {- | Returns the code actions in the specified range, resolving any with a non empty _data_ field. @@ -707,7 +713,7 @@ TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. L.range) ctx) case res of - Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e) + Left e -> throw (UnexpectedResponseError (fromJust rspLid) e) Right (InL cmdOrCAs) -> pure (acc ++ cmdOrCAs) Right (InR _) -> pure acc @@ -775,7 +781,7 @@ rsp <- request SMethod_CodeActionResolve ca case rsp ^. L.result of Right ca -> return ca - Left er -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) er) + Left er -> throw (UnexpectedResponseError (fromJust $ rsp ^. L.id) er) {- | If a code action contains a _data_ field: resolves the code action, then executes it. Otherwise, just executes it. @@ -843,7 +849,7 @@ rsp <- request SMethod_CompletionItemResolve ci case rsp ^. L.result of Right ci -> return ci - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (fromJust $ rsp ^. L.id) error) -- | Returns the references for the position in the document. getReferences :: @@ -931,11 +937,11 @@ {- | Checks the response for errors and throws an exception if needed. Returns the result if successful. -} -getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResult m +getResponseResult :: (Show (ErrorData m)) => TResponseMessage m -> MessageResult m getResponseResult rsp = case rsp ^. L.result of Right x -> x - Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) err + Left err -> throw $ UnexpectedResponseError (fromJust $ rsp ^. L.id) err -- | Applies formatting to the specified document. formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () @@ -978,8 +984,30 @@ rsp <- request SMethod_CodeLensResolve cl case rsp ^. L.result of Right cl -> return cl - Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. L.id) error) + Left error -> throw (UnexpectedResponseError (fromJust $ rsp ^. L.id) error) +-- | Returns the inlay hints in the specified range. +getInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint] +getInlayHints tId range = do + rsp <- request SMethod_TextDocumentInlayHint (InlayHintParams Nothing tId range) + pure $ absorbNull $ getResponseResult rsp + +{- | Returns the inlay hints in the specified range, resolving any with + a non empty _data_ field. +-} +getAndResolveInlayHints :: TextDocumentIdentifier -> Range -> Session [InlayHint] +getAndResolveInlayHints tId range = do + inlayHints <- getInlayHints tId range + for inlayHints $ \inlayHint -> if isJust (inlayHint ^. L.data_) then resolveInlayHint inlayHint else pure inlayHint + +-- | Resolves the provided inlay hint. +resolveInlayHint :: InlayHint -> Session InlayHint +resolveInlayHint ih = do + rsp <- request SMethod_InlayHintResolve ih + case rsp ^. L.result of + Right ih -> return ih + Left error -> throw (UnexpectedResponseError (fromJust $ rsp ^. L.id) error) + -- | Pass a param and return the response from `prepareCallHierarchy` prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem] prepareCallHierarchy = resolveRequestWithListResp SMethod_TextDocumentPrepareCallHierarchy @@ -993,7 +1021,7 @@ -- | Send a request and receive a response with list. resolveRequestWithListResp :: forall (m :: Method ClientToServer Request) a. - (ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) => + (Show (ErrorData m), MessageResult m ~ ([a] |? Null)) => SMethod m -> MessageParams m -> Session [a] diff --git a/src/Language/LSP/Test/Exceptions.hs b/src/Language/LSP/Test/Exceptions.hs --- a/src/Language/LSP/Test/Exceptions.hs +++ b/src/Language/LSP/Test/Exceptions.hs @@ -17,11 +17,10 @@ | ReplayOutOfOrder FromServerMessage [FromServerMessage] | UnexpectedDiagnostics | IncorrectApplyEditRequest String - | UnexpectedResponseError SomeLspId ResponseError + | forall m. Show (ErrorData m) => UnexpectedResponseError (LspId m) (TResponseError m) | UnexpectedServerTermination | IllegalInitSequenceMessage FromServerMessage | MessageSendError Value IOError - deriving (Eq) instance Exception SessionException diff --git a/src/Language/LSP/Test/Session.hs b/src/Language/LSP/Test/Session.hs --- a/src/Language/LSP/Test/Session.hs +++ b/src/Language/LSP/Test/Session.hs @@ -349,7 +349,7 @@ sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) $ if null errs then Right configs - else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> T.pack (show errs)) Nothing + else Left $ TResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> T.pack (show errs)) Nothing _ -> pure () unless ( (ignoringLogNotifications state && isLogNotification msg) diff --git a/test/DummyServer.hs b/test/DummyServer.hs --- a/test/DummyServer.hs +++ b/test/DummyServer.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module DummyServer where @@ -254,6 +255,27 @@ , requestHandler SMethod_TextDocumentSemanticTokensFull $ \_req resp -> do let tokens = makeSemanticTokens defaultSemanticTokensLegend [SemanticTokenAbsolute 0 1 2 SemanticTokenTypes_Type []] case tokens of - Left t -> resp $ Left $ ResponseError (InR ErrorCodes_InternalError) t Nothing + Left t -> resp $ Left $ TResponseError (InR ErrorCodes_InternalError) t Nothing Right tokens -> resp $ Right $ InL tokens + , requestHandler SMethod_TextDocumentInlayHint $ \req resp -> do + let TRequestMessage _ _ _ params = req + InlayHintParams _ _ (Range start end) = params + ih = + InlayHint + end + (InL ":: Text") + Nothing + Nothing + Nothing + Nothing + Nothing + (Just $ toJSON start) + resp $ Right $ InL [ih] + , requestHandler SMethod_InlayHintResolve $ \req resp -> do + let TRequestMessage _ _ _ params = req + (InlayHint{_data_ = Just data_, ..}) = params + start :: Position + Success start = fromJSON data_ + ih = InlayHint{_data_ = Nothing, _tooltip = Just $ InL $ "start at " <> T.pack (show start), ..} + resp $ Right ih ] diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -33,20 +33,20 @@ main = hspec $ around withDummyServer $ do describe "Session" $ do it "fails a test" $ \(hin, hout) -> - let session = runSessionWithHandles hin hout def fullCaps "." $ do + let session = runSessionWithHandles hin hout def fullLatestClientCaps "." $ do openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" anyRequest in session `shouldThrow` anySessionException - it "initializeResponse" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "initializeResponse" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do rsp <- initializeResponse liftIO $ rsp ^. L.result `shouldSatisfy` isRight it "runSessionWithConfig" $ \(hin, hout) -> - runSessionWithHandles hin hout def fullCaps "." $ return () + runSessionWithHandles hin hout def fullLatestClientCaps "." $ return () describe "withTimeout" $ do it "times out" $ \(hin, hout) -> - let sesh = runSessionWithHandles hin hout def fullCaps "." $ do + let sesh = runSessionWithHandles hin hout def fullLatestClientCaps "." $ do openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- won't receive a request - will timeout -- incoming logging requests shouldn't increase the @@ -57,13 +57,13 @@ timeout 6000000 sesh `shouldThrow` anySessionException it "doesn't time out" $ \(hin, hout) -> - let sesh = runSessionWithHandles hin hout def fullCaps "." $ do + let sesh = runSessionWithHandles hin hout def fullLatestClientCaps "." $ do openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification in void $ timeout 6000000 sesh it "further timeout messages are ignored" $ \(hin, hout) -> - runSessionWithHandles hin hout def fullCaps "." $ do + runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- shouldn't timeout withTimeout 3 $ getDocumentSymbols doc @@ -75,7 +75,7 @@ it "overrides global message timeout" $ \(hin, hout) -> let sesh = - runSessionWithHandles hin hout (def{messageTimeout = 5}) fullCaps "." $ do + runSessionWithHandles hin hout (def{messageTimeout = 5}) fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- shouldn't time out in here since we are overriding it withTimeout 10 $ liftIO $ threadDelay 7000000 @@ -85,7 +85,7 @@ it "unoverrides global message timeout" $ \(hin, hout) -> let sesh = - runSessionWithHandles hin hout (def{messageTimeout = 5}) fullCaps "." $ do + runSessionWithHandles hin hout (def{messageTimeout = 5}) fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- shouldn't time out in here since we are overriding it withTimeout 10 $ liftIO $ threadDelay 7000000 @@ -98,13 +98,13 @@ describe "SessionException" $ do it "throw on time out" $ \(hin, hout) -> - let sesh = runSessionWithHandles hin hout (def{messageTimeout = 10}) fullCaps "." $ do + let sesh = runSessionWithHandles hin hout (def{messageTimeout = 10}) fullLatestClientCaps "." $ do _ <- message SMethod_WorkspaceApplyEdit return () in sesh `shouldThrow` anySessionException it "don't throw when no time out" $ \(hin, hout) -> - runSessionWithHandles hin hout (def{messageTimeout = 5}) fullCaps "." $ do + runSessionWithHandles hin hout (def{messageTimeout = 5}) fullLatestClientCaps "." $ do liftIO $ threadDelay $ 6 * 1000000 _ <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" return () @@ -113,7 +113,7 @@ it "throws when there's an unexpected message" $ \(hin, hout) -> let selector (UnexpectedMessage "Publish diagnostics notification" (FromServerMess SMethod_WindowLogMessage _)) = True selector _ = False - in runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullCaps "." publishDiagnosticsNotification `shouldThrow` selector + in runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullLatestClientCaps "." publishDiagnosticsNotification `shouldThrow` selector it "provides the correct types that were expected and received" $ \(hin, hout) -> let selector (UnexpectedMessage "Response for: SMethod_TextDocumentRename" (FromServerRsp SMethod_TextDocumentDocumentSymbol _)) = True selector _ = False @@ -122,12 +122,12 @@ sendRequest SMethod_TextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) skipMany anyNotification response SMethod_TextDocumentRename -- the wrong type - in runSessionWithHandles hin hout def fullCaps "." sesh + in runSessionWithHandles hin hout def fullLatestClientCaps "." sesh `shouldThrow` selector describe "config" $ do it "updates config correctly" $ \(hin, hout) -> - runSessionWithHandles hin hout (def{ignoreConfigurationRequests = False}) fullCaps "." $ do + runSessionWithHandles hin hout (def{ignoreConfigurationRequests = False}) fullLatestClientCaps "." $ do configurationRequest -- initialized configuration request let requestConfig = do resp <- request (SMethod_CustomMethod (Proxy @"getConfig")) J.Null @@ -150,7 +150,7 @@ describe "text document VFS" $ do it "sends back didChange notifications (documentChanges)" $ \(hin, hout) -> - runSessionWithHandles hin hout def fullCaps "." $ do + runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" VersionedTextDocumentIdentifier _ beforeVersion <- getVersionedDoc doc @@ -180,7 +180,7 @@ liftIO $ reportedVersion `shouldNotBe` beforeVersion it "sends back didChange notifications" $ \(hin, hout) -> - runSessionWithHandles hin hout def fullCaps "." $ do + runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" let args = toJSON (doc ^. L.uri) @@ -198,7 +198,7 @@ describe "getDocumentEdit" $ it "automatically consumes applyedit requests" $ \(hin, hout) -> - runSessionWithHandles hin hout def fullCaps "." $ do + runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" let args = toJSON (doc ^. L.uri) @@ -208,7 +208,7 @@ liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n" describe "getCodeActions" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" waitForDiagnostics [InR action] <- getCodeActions doc (Range (Position 0 0) (Position 0 2)) @@ -217,7 +217,7 @@ liftIO $ actions `shouldSatisfy` null describe "getAllCodeActions" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell" _ <- waitForDiagnostics actions <- getAllCodeActions doc @@ -227,7 +227,7 @@ action ^. L.command . _Just . L.command `shouldBe` "deleteThis" describe "getDocumentSymbols" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" Right (mainSymbol : _) <- getDocumentSymbols doc @@ -238,13 +238,13 @@ mainSymbol ^. L.range `shouldBe` mkRange 0 0 3 6 describe "applyEdit" $ do - it "increments the version" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "increments the version" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" VersionedTextDocumentIdentifier _ oldVersion <- getVersionedDoc doc let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo" VersionedTextDocumentIdentifier _ newVersion <- applyEdit doc edit liftIO $ newVersion `shouldBe` oldVersion + 1 - it "changes the document contents" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "changes the document contents" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" applyEdit doc edit @@ -252,7 +252,7 @@ liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule" describe "getCompletions" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" comps <- getCompletions doc (Position 5 5) @@ -260,7 +260,7 @@ liftIO $ item ^. L.label `shouldBe` "foo" -- describe "getReferences" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- let pos = Position 40 3 -- interactWithUser -- uri = doc ^. LSP.uri @@ -272,21 +272,21 @@ -- ] -- describe "getDefinitions" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- let pos = Position 49 25 -- addItem -- defs <- getDefinitions doc pos -- liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 28 0 28 7)] -- describe "getTypeDefinitions" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- let pos = Position 20 23 -- Quit value -- defs <- getTypeDefinitions doc pos -- liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 10 0 14 19)] -- Type definition describe "waitForDiagnosticsSource" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do openDoc "test/data/Error.hs" "haskell" [diag] <- waitForDiagnosticsSource "dummy-server" liftIO $ do @@ -296,33 +296,33 @@ -- describe "rename" $ do -- it "works" $ \(hin, hout) -> pendingWith "HaRe not in hie-bios yet" -- it "works on javascript" $ - -- runSessionWithHandles hin hout "javascript-typescript-stdio" fullCaps "test/data/javascriptPass" $ do + -- runSessionWithHandles hin hout "javascript-typescript-stdio" fullLatestClientCaps "test/data/javascriptPass" $ do -- doc <- openDoc "test.js" "javascript" -- rename doc (Position 2 11) "bar" -- documentContents doc >>= liftIO . (`shouldContain` "function bar()") . T.unpack describe "getHover" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" hover <- getHover doc (Position 45 9) liftIO $ hover `shouldSatisfy` isJust -- describe "getHighlights" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" -- skipManyTill loggingNotification $ count 2 noDiagnostics -- highlights <- getHighlights doc (Position 27 4) -- addItem -- liftIO $ length highlights `shouldBe` 4 -- describe "formatDoc" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/Format.hs" "haskell" -- oldContents <- documentContents doc -- formatDoc doc (FormattingOptions 4 True) -- documentContents doc >>= liftIO . (`shouldNotBe` oldContents) -- describe "formatRange" $ - -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + -- it "works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do -- doc <- openDoc "test/data/Format.hs" "haskell" -- oldContents <- documentContents doc -- formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10)) @@ -331,7 +331,7 @@ describe "closeDoc" $ it "works" $ \(hin, hout) -> let sesh = - runSessionWithHandles hin hout def fullCaps "." $ do + runSessionWithHandles hin hout def fullLatestClientCaps "." $ do doc <- openDoc "test/data/Format.hs" "haskell" closeDoc doc -- need to evaluate to throw @@ -339,21 +339,21 @@ in sesh `shouldThrow` anyException describe "satisfy" $ - it "works" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullCaps "." $ do + it "works" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullLatestClientCaps "." $ do openDoc "test/data/Format.hs" "haskell" let pred (FromServerMess SMethod_WindowLogMessage _) = True pred _ = False void $ satisfy pred describe "satisfyMaybe" $ do - it "returns matched data on match" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullCaps "." $ do + it "returns matched data on match" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullLatestClientCaps "." $ do -- Wait for window/logMessage "initialized" from the server. let pred (FromServerMess SMethod_WindowLogMessage _) = Just "match" :: Maybe String pred _ = Nothing :: Maybe String result <- satisfyMaybe pred liftIO $ result `shouldBe` "match" - it "doesn't return if no match" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullCaps "." $ do + it "doesn't return if no match" $ \(hin, hout) -> runSessionWithHandles hin hout (def{ignoreLogNotifications = False}) fullLatestClientCaps "." $ do let pred (FromServerMess SMethod_TextDocumentPublishDiagnostics _) = Just "matched" :: Maybe String pred _ = Nothing :: Maybe String -- We expect a window/logMessage from the server, but @@ -363,13 +363,13 @@ describe "ignoreLogNotifications" $ it "works" $ \(hin, hout) -> - runSessionWithHandles hin hout (def{ignoreLogNotifications = True}) fullCaps "." $ do + runSessionWithHandles hin hout (def{ignoreLogNotifications = True}) fullLatestClientCaps "." $ do openDoc "test/data/Format.hs" "haskell" void publishDiagnosticsNotification describe "dynamic capabilities" $ do let config = def{ignoreLogNotifications = False} - it "keeps track" $ \(hin, hout) -> runSessionWithHandles hin hout config fullCaps "." $ do + it "keeps track" $ \(hin, hout) -> runSessionWithHandles hin hout config fullLatestClientCaps "." $ do loggingNotification -- initialized log message createDoc ".register" "haskell" "" setIgnoringRegistrationRequests False @@ -402,7 +402,7 @@ void $ sendRequest SMethod_TextDocumentHover $ HoverParams doc (Position 0 0) Nothing void $ anyResponse - it "handles absolute patterns" $ \(hin, hout) -> runSessionWithHandles hin hout config fullCaps "" $ do + it "handles absolute patterns" $ \(hin, hout) -> runSessionWithHandles hin hout config fullLatestClientCaps "" $ do loggingNotification -- initialized log message curDir <- liftIO $ getCurrentDirectory @@ -436,21 +436,31 @@ (Range (Position 1 2) (Position 3 4)) (Range (Position 1 2) (Position 3 4)) Nothing - it "prepare works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "prepare works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do rsp <- prepareCallHierarchy (params workPos) liftIO $ head rsp ^. L.range `shouldBe` Range (Position 2 3) (Position 4 5) - it "prepare not works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "prepare not works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do rsp <- prepareCallHierarchy (params notWorkPos) liftIO $ rsp `shouldBe` [] - it "incoming calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "incoming calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do [CallHierarchyIncomingCall _ fromRanges] <- incomingCalls (CallHierarchyIncomingCallsParams Nothing Nothing item) liftIO $ head fromRanges `shouldBe` Range (Position 2 3) (Position 4 5) - it "outgoing calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "outgoing calls" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do [CallHierarchyOutgoingCall _ fromRanges] <- outgoingCalls (CallHierarchyOutgoingCallsParams Nothing Nothing item) liftIO $ head fromRanges `shouldBe` Range (Position 4 5) (Position 2 3) describe "semantic tokens" $ do - it "full works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do + it "full works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do let doc = TextDocumentIdentifier (Uri "") InL toks <- getSemanticTokens doc liftIO $ toks ^. L.data_ `shouldBe` [0, 1, 2, 1, 0] + + describe "inlay hints" $ do + it "get works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do + doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" + inlayHints <- getInlayHints doc (Range (Position 1 2) (Position 3 4)) + liftIO $ head inlayHints ^. L.label `shouldBe` InL ":: Text" + it "resolve tooltip works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullLatestClientCaps "." $ do + doc <- openDoc "test/data/renamePass/Desktop/simple.hs" "haskell" + inlayHints <- getAndResolveInlayHints doc (Range (Position 1 2) (Position 3 4)) + liftIO $ head inlayHints ^. L.tooltip `shouldBe` Just (InL $ "start at " <> T.pack (show (Position 1 2)))