X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=19baf9671458b8540cbaa7683cd68c6afac6a6e1;hb=98ff10016bbd4eda3534ba04edcbc6e2ab9fd197;hp=81bdc8a8b465087baa960fbc6b1303e8497fcff7;hpb=a7fd35b1582f9816d8caa90a7b2e3aa765fb0446;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 81bdc8a..19baf96 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -56,6 +56,7 @@ module Language.Haskell.LSP.Test
   , waitForDiagnosticsSource
   , noDiagnostics
   , getCurrentDiagnostics
+  , getIncompleteProgressSessions
   -- ** Commands
   , executeCommand
   -- ** Code Actions
@@ -93,6 +94,7 @@ import Control.Monad.IO.Class
 import Control.Exception
 import Control.Lens hiding ((.=), List)
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Aeson
@@ -517,6 +519,10 @@ getCodeActionContext doc = do
 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
 getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
 
+-- | Returns the tokens of all progress sessions that have started but not yet ended.
+getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
+getIncompleteProgressSessions = curProgressSessions <$> get
+
 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do
@@ -611,9 +617,12 @@ getDefinitions doc pos = do
 getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
                    -> Position -- ^ The position the term is at.
                    -> Session [Location] -- ^ The location(s) of the definitions
-getTypeDefinitions doc pos =
+getTypeDefinitions doc pos = do
   let params = TextDocumentPositionParams doc pos Nothing
-  in getResponseResult <$> request TextDocumentTypeDefinition params
+  rsp <- request TextDocumentTypeDefinition params :: Session TypeDefinitionResponse
+  case getResponseResult rsp of
+    SingleLoc loc -> pure [loc]
+    MultiLoc locs -> pure locs
 
 -- | Renames the term at the specified position.
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
@@ -661,6 +670,7 @@ formatRange doc opts range = do
 applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
 applyTextEdits doc edits =
   let wEdit = WorkspaceEdit (Just (HashMap.singleton (doc ^. uri) edits)) Nothing
+      -- Send a dummy message to updateState so it can do bookkeeping
       req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)
   in updateState (ReqApplyWorkspaceEdit req)