-listenServer :: SessionContext -> IO ()
-listenServer context = do
- msgBytes <- getNextMessage (serverOut context)
-
- case decode msgBytes :: Maybe LogMessageNotification of
- -- Just print log and show messages
- Just (NotificationMessage _ WindowLogMessage (LogMessageParams _ msg)) -> T.putStrLn msg
- _ -> case decode msgBytes :: Maybe ShowMessageNotification of
- Just (NotificationMessage _ WindowShowMessage (ShowMessageParams _ msg)) -> T.putStrLn msg
- -- Give everything else for getMessage to handle
- _ -> putMVar (messageSema context) msgBytes
-
- listenServer context
-
--- | Sends a request to the server.
-sendRequest
- :: forall params resp. (ToJSON params, ToJSON resp, FromJSON resp)
- => Proxy (RequestMessage ClientMethod params resp)
- -> ClientMethod
- -> params
- -> Session LspId
-sendRequest _ method params = do
- h <- serverIn <$> lift ask
+listenServer :: Handle -> Session ()
+listenServer serverOut = do
+ msgBytes <- liftIO $ getNextMessage serverOut
+
+ context <- ask
+ reqMap <- liftIO $ readMVar $ requestMap context
+
+ let msg = decodeFromServerMsg reqMap msgBytes
+ liftIO $ writeChan (messageChan context) msg
+
+ listenServer serverOut
+
+-- | The current text contents of a document.
+documentContents :: TextDocumentIdentifier -> Session T.Text
+documentContents doc = do
+ vfs <- vfs <$> get
+ let file = vfs Map.! (doc ^. uri)
+ return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
+
+-- | Parses an ApplyEditRequest, checks that it is for the passed document
+-- and returns the new content
+getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
+getDocumentEdit doc = do
+ req <- request :: Session ApplyWorkspaceEditRequest
+
+ unless (checkDocumentChanges req || checkChanges req) $
+ liftIO $ throw (IncorrectApplyEditRequestException (show req))
+
+ documentContents doc
+ where
+ checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
+ checkDocumentChanges req =
+ let changes = req ^. params . edit . documentChanges
+ maybeDocs = fmap (fmap (^. textDocument . uri)) 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
+
+-- | Sends a request to the server and waits for its response.
+-- @
+-- rsp <- sendRequest TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
+-- @
+-- Note: will skip any messages in between the request and the response.
+sendRequest :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
+sendRequest m = sendRequest' m >=> skipManyTill anyMessage . responseForId
+
+-- | Send a request to the server and wait for its response,
+-- but discard it.
+sendRequest_ :: ToJSON params => ClientMethod -> params -> Session ()
+sendRequest_ p = void . (sendRequest p :: ToJSON params => params -> Session (ResponseMessage Value))