X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest.hs;h=6c5c4a6674681b0a077352f9274864737eb1bad5;hb=a3f3199c221524124aeabce9a91e73655800a862;hp=40215471600e1e7e7d47887d85251f8b477ebc75;hpb=aa0ac8a0a985651741e11efc3af3973db88cf80f;p=lsp-test.git

diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs
index 4021547..6c5c4a6 100644
--- a/src/Language/LSP/Test.hs
+++ b/src/Language/LSP/Test.hs
@@ -62,6 +62,7 @@ module Language.LSP.Test
   , waitForDiagnosticsSource
   , noDiagnostics
   , getCurrentDiagnostics
+  , getIncompleteProgressSessions
   -- ** Commands
   , executeCommand
   -- ** Code Actions
@@ -101,6 +102,7 @@ import Control.Monad.IO.Class
 import Control.Exception
 import Control.Lens hiding ((.=), List, Empty)
 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
@@ -134,7 +136,7 @@ import qualified System.FilePath.Glob as Glob
 -- >   diags <- waitForDiagnostics
 -- >   let pos = Position 12 5
 -- >       params = TextDocumentPositionParams doc
--- >   hover <- request TextDocumentHover params
+-- >   hover <- request STextdocumentHover params
 runSession :: String -- ^ The command to run the server.
            -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
            -> FilePath -- ^ The filepath to the root directory for the session.
@@ -156,13 +158,13 @@ runSessionWithConfig config' serverExe caps rootDir session = do
 
 -- | Starts a new session, using the specified handles to communicate with the
 -- server. You can use this to host the server within the same process.
--- An example with haskell-lsp might look like:
+-- An example with lsp might look like:
 --
 -- > (hinRead, hinWrite) <- createPipe
 -- > (houtRead, houtWrite) <- createPipe
 -- > 
--- > forkIO $ void $ runWithHandles hinRead houtWrite initCallbacks handlers def
--- > Test.runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
+-- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
+-- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
 -- >   -- ...
 runSessionWithHandles :: Handle -- ^ The input handle
                       -> Handle -- ^ The output handle
@@ -199,7 +201,6 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
                                           (List <$> initialWorkspaceFolders config)
   runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
     -- Wrap the session around initialize and shutdown calls
-    -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
     initReqId <- sendRequest SInitialize initializeParams
 
     -- Because messages can be sent in between the request and response,
@@ -284,14 +285,12 @@ getDocumentEdit doc = do
 
   documentContents doc
   where
-    checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
     checkDocumentChanges req =
       let changes = req ^. params . edit . documentChanges
-          maybeDocs = fmap (fmap (^. textDocument . uri)) changes
+          maybeDocs = fmap (fmap documentChangeUri) changes
       in case maybeDocs of
         Just docs -> (doc ^. uri) `elem` docs
         Nothing -> False
-    checkChanges :: ApplyWorkspaceEditRequest -> Bool
     checkChanges req =
       let mMap = req ^. params . edit . changes
         in maybe False (HashMap.member (doc ^. uri)) mMap
@@ -299,7 +298,7 @@ getDocumentEdit doc = do
 -- | Sends a request to the server and waits for its response.
 -- Will skip any messages in between the request and the response
 -- @
--- rsp <- request TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
+-- rsp <- request STextDocumentDocumentSymbol params
 -- @
 -- Note: will skip any messages in between the request and the response.
 request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
@@ -371,8 +370,8 @@ sendResponse = sendMessage
 -- | Returns the initialize response that was received from the server.
 -- The initialize requests and responses are not included the session,
 -- so if you need to test it use this.
-initializeResponse :: Session InitializeResponse
-initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
+initializeResponse :: Session (ResponseMessage Initialize)
+initializeResponse = ask >>= (liftIO . readMVar) . initRsp
 
 -- | /Creates/ a new text document. This is different from 'openDoc'
 -- as it sends a workspace/didChangeWatchedFiles notification letting the server
@@ -384,7 +383,7 @@ initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 --
 -- @since 11.0.0.0
 createDoc :: FilePath -- ^ The path to the document to open, __relative to the root directory__.
-          -> String -- ^ The text document's language identifier, e.g. @"haskell"@.
+          -> T.Text -- ^ The text document's language identifier, e.g. @"haskell"@.
           -> T.Text -- ^ The content of the text document to create.
           -> Session TextDocumentIdentifier -- ^ The identifier of the document just created.
 createDoc file languageId contents = do
@@ -399,7 +398,7 @@ createDoc file languageId contents = do
       watchHits :: FileSystemWatcher -> Bool
       watchHits (FileSystemWatcher pattern kind) =
         -- If WatchKind is exlcuded, defaults to all true as per spec
-        fileMatches pattern && createHits (fromMaybe (WatchKind True True True) kind)
+        fileMatches (T.unpack pattern) && createHits (fromMaybe (WatchKind True True True) kind)
 
       fileMatches pattern = Glob.match (Glob.compile pattern) relOrAbs
         -- If the pattern is absolute then match against the absolute fp
@@ -424,7 +423,7 @@ createDoc file languageId contents = do
 
 -- | Opens a text document that /exists on disk/, and sends a
 -- textDocument/didOpen notification to the server.
-openDoc :: FilePath -> String -> Session TextDocumentIdentifier
+openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier
 openDoc file languageId = do
   context <- ask
   let fp = rootDir context </> file
@@ -433,12 +432,12 @@ openDoc file languageId = do
 
 -- | This is a variant of `openDoc` that takes the file content as an argument.
 -- Use this is the file exists /outside/ of the current workspace.
-openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
+openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier
 openDoc' file languageId contents = do
   context <- ask
   let fp = rootDir context </> file
       uri = filePathToUri fp
-      item = TextDocumentItem uri (T.pack languageId) 0 contents
+      item = TextDocumentItem uri languageId 0 contents
   sendNotification STextDocumentDidOpen (DidOpenTextDocumentParams item)
   pure $ TextDocumentIdentifier uri
 
@@ -493,7 +492,7 @@ noDiagnostics = do
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
 getDocumentSymbols doc = do
-  ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc) :: Session DocumentSymbolsResponse
+  ResponseMessage _ rspLid res <- request STextDocumentDocumentSymbol (DocumentSymbolParams Nothing Nothing doc)
   case res of
     Right (InL (List xs)) -> return (Left xs)
     Right (InR (List xs)) -> return (Right xs)
@@ -537,6 +536,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
@@ -586,7 +589,7 @@ applyEdit doc edit = do
   let wEdit = if supportsDocChanges
       then
         let docEdit = TextDocumentEdit verDoc (List [edit])
-        in WorkspaceEdit Nothing (Just (List [docEdit]))
+        in WorkspaceEdit Nothing (Just (List [InL docEdit]))
       else
         let changes = HashMap.singleton (doc ^. uri) (List [edit])
         in WorkspaceEdit (Just changes) Nothing
@@ -663,7 +666,7 @@ getDeclarationyRequest method paramCons doc pos = do
 rename :: TextDocumentIdentifier -> Position -> String -> Session ()
 rename doc pos newName = do
   let params = RenameParams doc pos Nothing (T.pack newName)
-  rsp <- request STextDocumentRename params :: Session RenameResponse
+  rsp <- request STextDocumentRename params
   let wEdit = getResponseResult rsp
       req = RequestMessage "" (IdInt 0) SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
   updateState (FromServerMess SWorkspaceApplyEdit req)
@@ -712,7 +715,7 @@ applyTextEdits doc edits =
 -- | Returns the code lenses for the specified document.
 getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
 getCodeLenses tId = do
-    rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId) :: Session CodeLensResponse
+    rsp <- request STextDocumentCodeLens (CodeLensParams Nothing Nothing tId)
     case getResponseResult rsp of
         List res -> pure res
 
@@ -721,4 +724,4 @@ getCodeLenses tId = do
 --
 -- @since 0.11.0.0
 getRegisteredCapabilities :: Session [SomeRegistration]
-getRegisteredCapabilities = (Map.elems . curDynCaps) <$> get
+getRegisteredCapabilities = Map.elems . curDynCaps <$> get