X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=403c0e112600acda919a77656434e8a792f089d8;hb=0d03bbc4a85a2d625fa663a47bcd079883bf7900;hp=3def44000291d1e495cdc3924be80da94a4762b8;hpb=f940434fbd873e90124a46bd1386c59e8cee49f7;p=opengl.git diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 3def440..403c0e1 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -9,7 +9,9 @@ -- Maintainer : luke_lau@icloud.com -- Stability : experimental -- --- A framework for testing at the JSON level. +-- A framework for testing +-- +-- functionally. module Language.Haskell.LSP.Test ( @@ -63,6 +65,12 @@ module Language.Haskell.LSP.Test , getCompletions -- ** References , getReferences + -- ** Definitions + , getDefinitions + -- ** Renaming + , rename + -- ** Hover + , getHover -- ** Edits , applyEdit ) where @@ -422,15 +430,47 @@ getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] getCompletions doc pos = do rsp <- sendRequest TextDocumentCompletion (TextDocumentPositionParams doc pos) - let exc = throw $ UnexpectedResponseError (rsp ^. LSP.id) - (fromJust $ rsp ^. LSP.error) - res = fromMaybe exc (rsp ^. result) - case res of + case getResponseResult rsp of Completions (List items) -> return items CompletionList (CompletionListType _ (List items)) -> return items -getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [Location] +-- | Returns the references for the position in the document. +getReferences :: TextDocumentIdentifier -- ^ The document to lookup in. + -> Position -- ^ The position to lookup. + -> Bool -- ^ Whether to include declarations as references. + -> Session [Location] -- ^ The locations of the references. getReferences doc pos inclDecl = let ctx = ReferenceContext inclDecl params = ReferenceParams doc pos ctx - in fromMaybe [] . (^. result) <$> sendRequest TextDocumentReferences params + in getResponseResult <$> sendRequest TextDocumentReferences params + +-- | Returns the definition(s) for the term at the specified position. +getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. + -> Position -- ^ The position the term is at. + -> Session [Location] -- ^ The location(s) of the definitions +getDefinitions doc pos = + let params = TextDocumentPositionParams doc pos + in getResponseResult <$> sendRequest TextDocumentDefinition params + +-- ^ Renames the term at the specified position. +rename :: TextDocumentIdentifier -> Position -> String -> Session () +rename doc pos newName = do + let params = RenameParams doc pos (T.pack newName) + rsp <- sendRequest TextDocumentRename params :: Session RenameResponse + let wEdit = getResponseResult rsp + req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit) + updateState (ReqApplyWorkspaceEdit req) + +-- ^ Returns the hover information at the specified position. +getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) +getHover doc pos = do + let params = TextDocumentPositionParams doc pos + getResponseResult <$> sendRequest TextDocumentHover params + +-- | Checks the response for errors and throws an exception if needed. +-- Returns the result if successful. +getResponseResult :: ResponseMessage a -> a +getResponseResult rsp = fromMaybe exc (rsp ^. result) + where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id) + (fromJust $ rsp ^. LSP.error) +