{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
-- > 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.
-- | 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
(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,
documentContents doc
where
- checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
+ -- extract Uri out from DocumentChange
+ documentChangeUri :: DocumentChange -> Uri
+ documentChangeUri (InL x) = x ^. textDocument . uri
+ documentChangeUri (InR (InL x)) = x ^. uri
+ documentChangeUri (InR (InR (InL x))) = x ^. oldUri
+ documentChangeUri (InR (InR (InR x))) = x ^. uri
+
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
-- | 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)
IsClientEither -> sendMessage (NotMess $ NotificationMessage "2.0" method params)
-- | Sends a response to the server.
-sendResponse :: ToJSON (ResponseParams m) => ResponseMessage m -> Session ()
+sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
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 :: Session (ResponseMessage Initialize)
initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
-- | /Creates/ a new text document. This is different from 'openDoc'
-- | 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)
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
getImplementations = getDeclarationyRequest STextDocumentImplementation ImplementationParams
-getDeclarationyRequest :: (ResponseParams m ~ (Location |? (List Location |? List LocationLink)))
+getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
=> SClientMethod m
-> (TextDocumentIdentifier
-> Position
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)
-- | Checks the response for errors and throws an exception if needed.
-- Returns the result if successful.
-getResponseResult :: ResponseMessage m -> ResponseParams m
+getResponseResult :: ResponseMessage m -> ResponseResult m
getResponseResult rsp =
case rsp ^. result of
Right x -> x
-- | 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