diff --git a/lsp-test/src/Language/LSP/Test.hs b/lsp-test/src/Language/LSP/Test.hs index 52979fcd..a2e90570 100644 --- a/lsp-test/src/Language/LSP/Test.hs +++ b/lsp-test/src/Language/LSP/Test.hs @@ -124,6 +124,11 @@ module Language.LSP.Test ( getAndResolveCodeLenses, resolveCodeLens, + -- ** Inlay Hints + getInlayHints, + getAndResolveInlayHints, + resolveInlayHint, + -- ** Call hierarchy prepareCallHierarchy, incomingCalls, @@ -981,6 +986,28 @@ resolveCodeLens cl = do Right cl -> return cl Left error -> throw (UnexpectedResponseError (SomeLspId $ 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 (SomeLspId $ fromJust $ rsp ^. L.id) error) + -- | Pass a param and return the response from `prepareCallHierarchy` prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem] prepareCallHierarchy = resolveRequestWithListResp SMethod_TextDocumentPrepareCallHierarchy diff --git a/lsp-test/test/DummyServer.hs b/lsp-test/test/DummyServer.hs index 3189d2c9..32789fcc 100644 --- a/lsp-test/test/DummyServer.hs +++ b/lsp-test/test/DummyServer.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module DummyServer where @@ -256,4 +257,25 @@ handlers = case tokens of Left t -> resp $ Left $ ResponseError (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/lsp-test/test/Test.hs b/lsp-test/test/Test.hs index 8e450c23..d2f8176a 100644 --- a/lsp-test/test/Test.hs +++ b/lsp-test/test/Test.hs @@ -454,3 +454,13 @@ main = hspec $ around withDummyServer $ 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 fullCaps "." $ 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 fullCaps "." $ 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)))