X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=c5090f939c8c669f44e65a5d04d698d2bb7a6350;hb=b39cc258cdffae26e2a783470995df73e4099070;hp=3ba86905c2d48d6c015812421253fa7319f3a3e6;hpb=bece589927102eb7cc66db5200ec11b568d35748;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 3ba8690..c5090f9 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -52,6 +52,7 @@ module Language.Haskell.LSP.Test
   , getDocumentSymbols
   -- ** Diagnostics
   , waitForDiagnostics
+  , waitForDiagnosticsSource
   , noDiagnostics
   -- ** Commands
   , executeCommand
@@ -60,6 +61,10 @@ module Language.Haskell.LSP.Test
   , executeCodeAction
   -- ** Completions
   , getCompletions
+  -- ** References
+  , getReferences
+  -- ** Renaming
+  , rename
   -- ** Edits
   , applyEdit
   ) where
@@ -306,6 +311,17 @@ waitForDiagnostics = do
   let (List diags) = diagsNot ^. params . LSP.diagnostics
   return diags
 
+waitForDiagnosticsSource :: String -> Session [Diagnostic]
+waitForDiagnosticsSource src = do
+  diags <- waitForDiagnostics
+  let res = filter matches diags
+  if null res
+    then waitForDiagnosticsSource src
+    else return res
+  where
+    matches :: Diagnostic -> Bool
+    matches d = d ^. source == Just (T.pack src)
+
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 -- 'UnexpectedDiagnosticsException' if there are any diagnostics
 -- returned.
@@ -408,9 +424,33 @@ 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
+
+-- | 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 
+
+-- ^ 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)
+
+-- | 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)
+