, filepath
, text
, transformers
+ , parsec
, process
, directory
, containers
else
build-depends: unix
other-modules: Language.Haskell.LSP.Test.Compat
+ Language.Haskell.LSP.Test.Decoding
Language.Haskell.LSP.Test.Files
Language.Haskell.LSP.Test.Parsing
+ Language.Haskell.LSP.Test.Messages
ghc-options: -W
test-suite tests
import System.IO
import System.Directory
import System.FilePath
-import Language.Haskell.LSP.Test.Parsing
+import Language.Haskell.LSP.Test.Decoding
data SessionContext = SessionContext
{
--- /dev/null
+{-# LANGUAGE OverloadedStrings #-}
+module Language.Haskell.LSP.Test.Decoding where
+
+import Prelude hiding ( id )
+import Data.Aeson
+import Control.Lens
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Maybe
+import System.IO
+import Language.Haskell.LSP.Types
+ hiding ( error )
+import Language.Haskell.LSP.Messages
+import qualified Data.HashMap.Strict as HM
+
+getAllMessages :: Handle -> IO [B.ByteString]
+getAllMessages h = do
+ done <- hIsEOF h
+ if done
+ then return []
+ else do
+ msg <- getNextMessage h
+
+ (msg :) <$> getAllMessages h
+
+-- | Fetches the next message bytes based on
+-- the Content-Length header
+getNextMessage :: Handle -> IO B.ByteString
+getNextMessage h = do
+ headers <- getHeaders h
+ case read . init <$> lookup "Content-Length" headers of
+ Nothing -> error "Couldn't read Content-Length header"
+ Just size -> B.hGet h size
+
+addHeader :: B.ByteString -> B.ByteString
+addHeader content = B.concat
+ [ "Content-Length: "
+ , B.pack $ show $ B.length content
+ , "\r\n"
+ , "\r\n"
+ , content
+ ]
+
+getHeaders :: Handle -> IO [(String, String)]
+getHeaders h = do
+ l <- hGetLine h
+ let (name, val) = span (/= ':') l
+ if null val then return [] else ((name, drop 2 val) :) <$> getHeaders h
+
+type RequestMap = HM.HashMap LspId FromClientMessage
+
+getRequestMap :: [FromClientMessage] -> RequestMap
+getRequestMap = foldl helper HM.empty
+ where
+ helper acc msg = case msg of
+ (ReqInitialize val) -> insert val msg acc
+ (ReqShutdown val) -> insert val msg acc
+ (ReqHover val) -> insert val msg acc
+ (ReqCompletion val) -> insert val msg acc
+ (ReqCompletionItemResolve val) -> insert val msg acc
+ (ReqSignatureHelp val) -> insert val msg acc
+ (ReqDefinition val) -> insert val msg acc
+ (ReqFindReferences val) -> insert val msg acc
+ (ReqDocumentHighlights val) -> insert val msg acc
+ (ReqDocumentSymbols val) -> insert val msg acc
+ (ReqWorkspaceSymbols val) -> insert val msg acc
+ (ReqCodeAction val) -> insert val msg acc
+ (ReqCodeLens val) -> insert val msg acc
+ (ReqCodeLensResolve val) -> insert val msg acc
+ (ReqDocumentFormatting val) -> insert val msg acc
+ (ReqDocumentRangeFormatting val) -> insert val msg acc
+ (ReqDocumentOnTypeFormatting val) -> insert val msg acc
+ (ReqRename val) -> insert val msg acc
+ (ReqExecuteCommand val) -> insert val msg acc
+ (ReqDocumentLink val) -> insert val msg acc
+ (ReqDocumentLinkResolve val) -> insert val msg acc
+ (ReqWillSaveWaitUntil val) -> insert val msg acc
+ _ -> acc
+ insert m = HM.insert (m ^. id)
+
+matchResponseMsgType :: FromClientMessage -> B.ByteString -> FromServerMessage
+matchResponseMsgType req bytes = case req of
+ ReqInitialize _ -> RspInitialize $ fromJust $ decode bytes
+ ReqShutdown _ -> RspShutdown $ fromJust $ decode bytes
+ ReqHover _ -> RspHover $ fromJust $ decode bytes
+ ReqCompletion _ -> RspCompletion $ fromJust $ decode bytes
+ ReqCompletionItemResolve _ ->
+ RspCompletionItemResolve $ fromJust $ decode bytes
+ ReqSignatureHelp _ -> RspSignatureHelp $ fromJust $ decode bytes
+ ReqDefinition _ -> RspDefinition $ fromJust $ decode bytes
+ ReqFindReferences _ -> RspFindReferences $ fromJust $ decode bytes
+ ReqDocumentHighlights _ -> RspDocumentHighlights $ fromJust $ decode bytes
+ ReqDocumentSymbols _ -> RspDocumentSymbols $ fromJust $ decode bytes
+ ReqWorkspaceSymbols _ -> RspWorkspaceSymbols $ fromJust $ decode bytes
+ ReqCodeAction _ -> RspCodeAction $ fromJust $ decode bytes
+ ReqCodeLens _ -> RspCodeLens $ fromJust $ decode bytes
+ ReqCodeLensResolve _ -> RspCodeLensResolve $ fromJust $ decode bytes
+ ReqDocumentFormatting _ -> RspDocumentFormatting $ fromJust $ decode bytes
+ ReqDocumentRangeFormatting _ ->
+ RspDocumentRangeFormatting $ fromJust $ decode bytes
+ ReqDocumentOnTypeFormatting _ ->
+ RspDocumentOnTypeFormatting $ fromJust $ decode bytes
+ ReqRename _ -> RspRename $ fromJust $ decode bytes
+ ReqExecuteCommand _ -> RspExecuteCommand $ fromJust $ decode bytes
+ ReqDocumentLink _ -> RspDocumentLink $ fromJust $ decode bytes
+ ReqDocumentLinkResolve _ -> RspDocumentLinkResolve $ fromJust $ decode bytes
+ ReqWillSaveWaitUntil _ -> RspWillSaveWaitUntil $ fromJust $ decode bytes
+ x -> error $ "Not a request: " ++ show x
+
+decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
+decodeFromServerMsg reqMap bytes =
+ case HM.lookup "method" (fromJust $ decode bytes :: Object) of
+ Just methodStr -> case fromJSON methodStr of
+ Success method -> case method of
+ -- We can work out the type of the message
+ TextDocumentPublishDiagnostics -> NotPublishDiagnostics $ fromJust $ decode bytes
+ WindowShowMessage -> NotShowMessage $ fromJust $ decode bytes
+ WindowLogMessage -> NotLogMessage $ fromJust $ decode bytes
+ CancelRequestServer -> NotCancelRequestFromServer $ fromJust $ decode bytes
+ TelemetryEvent -> NotTelemetry $ fromJust $ decode bytes
+ WindowShowMessageRequest -> ReqShowMessage $ fromJust $ decode bytes
+ ClientRegisterCapability -> ReqRegisterCapability $ fromJust $ decode bytes
+ ClientUnregisterCapability -> ReqUnregisterCapability $ fromJust $ decode bytes
+ WorkspaceApplyEdit -> ReqApplyWorkspaceEdit $ fromJust $ decode bytes
+
+ Error e -> error e
+
+ Nothing -> case decode bytes :: Maybe (ResponseMessage Value) of
+ Just msg -> case HM.lookup (requestId $ msg ^. id) reqMap of
+ Just req -> matchResponseMsgType req bytes -- try to decode it to more specific type
+ Nothing -> error "Couldn't match up response with request"
+ Nothing -> error "Couldn't decode message"
\ No newline at end of file
--- /dev/null
+{-# LANGUAGE RankNTypes #-}
+module Language.Haskell.LSP.Test.Messages where
+
+import Data.Aeson
+import Language.Haskell.LSP.Messages
+import Language.Haskell.LSP.Types hiding (error)
+
+isServerResponse :: FromServerMessage -> Bool
+isServerResponse (RspInitialize _) = True
+isServerResponse (RspShutdown _) = True
+isServerResponse (RspHover _) = True
+isServerResponse (RspCompletion _) = True
+isServerResponse (RspCompletionItemResolve _) = True
+isServerResponse (RspSignatureHelp _) = True
+isServerResponse (RspDefinition _) = True
+isServerResponse (RspFindReferences _) = True
+isServerResponse (RspDocumentHighlights _) = True
+isServerResponse (RspDocumentSymbols _) = True
+isServerResponse (RspWorkspaceSymbols _) = True
+isServerResponse (RspCodeAction _) = True
+isServerResponse (RspCodeLens _) = True
+isServerResponse (RspCodeLensResolve _) = True
+isServerResponse (RspDocumentFormatting _) = True
+isServerResponse (RspDocumentRangeFormatting _) = True
+isServerResponse (RspDocumentOnTypeFormatting _) = True
+isServerResponse (RspRename _) = True
+isServerResponse (RspExecuteCommand _) = True
+isServerResponse (RspError _) = True
+isServerResponse (RspDocumentLink _) = True
+isServerResponse (RspDocumentLinkResolve _) = True
+isServerResponse (RspWillSaveWaitUntil _) = True
+isServerResponse _ = False
+
+isServerRequest :: FromServerMessage -> Bool
+isServerRequest (ReqRegisterCapability _) = True
+isServerRequest (ReqApplyWorkspaceEdit _) = True
+isServerRequest (ReqShowMessage _) = True
+isServerRequest (ReqUnregisterCapability _) = True
+isServerRequest _ = False
+
+isServerNotification :: FromServerMessage -> Bool
+isServerNotification (NotPublishDiagnostics _) = True
+isServerNotification (NotLogMessage _) = True
+isServerNotification (NotShowMessage _) = True
+isServerNotification (NotTelemetry _) = True
+isServerNotification (NotCancelRequestFromServer _) = True
+isServerNotification _ = False
+
+handleServerMessage
+ :: forall a.
+ (forall b c . RequestMessage ServerMethod b c -> a)
+ -> (forall d . ResponseMessage d -> a)
+ -> (forall e . NotificationMessage ServerMethod e -> a)
+ -> FromServerMessage
+ -> a
+handleServerMessage request response notification msg = case msg of
+ (ReqRegisterCapability m) -> request m
+ (ReqApplyWorkspaceEdit m) -> request m
+ (ReqShowMessage m) -> request m
+ (ReqUnregisterCapability m) -> request m
+ (RspInitialize m) -> response m
+ (RspShutdown m) -> response m
+ (RspHover m) -> response m
+ (RspCompletion m) -> response m
+ (RspCompletionItemResolve m) -> response m
+ (RspSignatureHelp m) -> response m
+ (RspDefinition m) -> response m
+ (RspFindReferences m) -> response m
+ (RspDocumentHighlights m) -> response m
+ (RspDocumentSymbols m) -> response m
+ (RspWorkspaceSymbols m) -> response m
+ (RspCodeAction m) -> response m
+ (RspCodeLens m) -> response m
+ (RspCodeLensResolve m) -> response m
+ (RspDocumentFormatting m) -> response m
+ (RspDocumentRangeFormatting m) -> response m
+ (RspDocumentOnTypeFormatting m) -> response m
+ (RspRename m) -> response m
+ (RspExecuteCommand m) -> response m
+ (RspError m) -> response m
+ (RspDocumentLink m) -> response m
+ (RspDocumentLinkResolve m) -> response m
+ (RspWillSaveWaitUntil m) -> response m
+ (NotPublishDiagnostics m) -> notification m
+ (NotLogMessage m) -> notification m
+ (NotShowMessage m) -> notification m
+ (NotTelemetry m) -> notification m
+ (NotCancelRequestFromServer m) -> notification m
+
+handleClientMessage
+ :: forall a.
+ (forall b c . (ToJSON b, ToJSON c) => RequestMessage ClientMethod b c -> a)
+ -> (forall d . ToJSON d => ResponseMessage d -> a)
+ -> (forall e . ToJSON e => NotificationMessage ClientMethod e -> a)
+ -> FromClientMessage
+ -> a
+handleClientMessage request response notification msg = case msg of
+ (ReqInitialize m) -> request m
+ (ReqShutdown m) -> request m
+ (ReqHover m) -> request m
+ (ReqCompletion m) -> request m
+ (ReqCompletionItemResolve m) -> request m
+ (ReqSignatureHelp m) -> request m
+ (ReqDefinition m) -> request m
+ (ReqFindReferences m) -> request m
+ (ReqDocumentHighlights m) -> request m
+ (ReqDocumentSymbols m) -> request m
+ (ReqWorkspaceSymbols m) -> request m
+ (ReqCodeAction m) -> request m
+ (ReqCodeLens m) -> request m
+ (ReqCodeLensResolve m) -> request m
+ (ReqDocumentFormatting m) -> request m
+ (ReqDocumentRangeFormatting m) -> request m
+ (ReqDocumentOnTypeFormatting m) -> request m
+ (ReqRename m) -> request m
+ (ReqExecuteCommand m) -> request m
+ (ReqDocumentLink m) -> request m
+ (ReqDocumentLinkResolve m) -> request m
+ (ReqWillSaveWaitUntil m) -> request m
+ (RspApplyWorkspaceEdit m) -> response m
+ (RspFromClient m) -> response m
+ (NotInitialized m) -> notification m
+ (NotExit m) -> notification m
+ (NotCancelRequestFromClient m) -> notification m
+ (NotDidChangeConfiguration m) -> notification m
+ (NotDidOpenTextDocument m) -> notification m
+ (NotDidChangeTextDocument m) -> notification m
+ (NotDidCloseTextDocument m) -> notification m
+ (NotWillSaveTextDocument m) -> notification m
+ (NotDidSaveTextDocument m) -> notification m
+ (NotDidChangeWatchedFiles m) -> notification m
+ (UnknownFromClientMessage m) -> error $ "Unknown message sent from client: " ++ show m
\ No newline at end of file
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.LSP.Test.Parsing where
-import Prelude hiding ( id )
-import Data.Aeson
-import Control.Lens
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.Maybe
-import System.IO
-import Language.Haskell.LSP.Types
- hiding ( error )
import Language.Haskell.LSP.Messages
-import qualified Data.HashMap.Strict as HM
-
-getAllMessages :: Handle -> IO [B.ByteString]
-getAllMessages h = do
- done <- hIsEOF h
- if done
- then return []
- else do
- msg <- getNextMessage h
-
- (msg :) <$> getAllMessages h
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Test.Messages
+import Text.Parsec hiding (satisfy)
--- | Fetches the next message bytes based on
--- the Content-Length header
-getNextMessage :: Handle -> IO B.ByteString
-getNextMessage h = do
- headers <- getHeaders h
- case read . init <$> lookup "Content-Length" headers of
- Nothing -> error "Couldn't read Content-Length header"
- Just size -> B.hGet h size
+data MessageParserState = MessageParserState
-addHeader :: B.ByteString -> B.ByteString
-addHeader content = B.concat
- [ "Content-Length: "
- , B.pack $ show $ B.length content
- , "\r\n"
- , "\r\n"
- , content
- ]
+type MessageParser = Parsec [FromServerMessage] MessageParserState
-getHeaders :: Handle -> IO [(String, String)]
-getHeaders h = do
- l <- hGetLine h
- let (name, val) = span (/= ':') l
- if null val then return [] else ((name, drop 2 val) :) <$> getHeaders h
+notification :: MessageParser FromServerMessage
+notification = satisfy isServerNotification
-type RequestMap = HM.HashMap LspId FromClientMessage
+request :: MessageParser FromServerMessage
+request = satisfy isServerRequest
-getRequestMap :: [FromClientMessage] -> RequestMap
-getRequestMap = foldl helper HM.empty
- where
- helper acc msg = case msg of
- (ReqInitialize val) -> insert val msg acc
- (ReqShutdown val) -> insert val msg acc
- (ReqHover val) -> insert val msg acc
- (ReqCompletion val) -> insert val msg acc
- (ReqCompletionItemResolve val) -> insert val msg acc
- (ReqSignatureHelp val) -> insert val msg acc
- (ReqDefinition val) -> insert val msg acc
- (ReqFindReferences val) -> insert val msg acc
- (ReqDocumentHighlights val) -> insert val msg acc
- (ReqDocumentSymbols val) -> insert val msg acc
- (ReqWorkspaceSymbols val) -> insert val msg acc
- (ReqCodeAction val) -> insert val msg acc
- (ReqCodeLens val) -> insert val msg acc
- (ReqCodeLensResolve val) -> insert val msg acc
- (ReqDocumentFormatting val) -> insert val msg acc
- (ReqDocumentRangeFormatting val) -> insert val msg acc
- (ReqDocumentOnTypeFormatting val) -> insert val msg acc
- (ReqRename val) -> insert val msg acc
- (ReqExecuteCommand val) -> insert val msg acc
- (ReqDocumentLink val) -> insert val msg acc
- (ReqDocumentLinkResolve val) -> insert val msg acc
- (ReqWillSaveWaitUntil val) -> insert val msg acc
- _ -> acc
- insert m = HM.insert (m ^. id)
+response :: MessageParser FromServerMessage
+response = satisfy isServerResponse
-matchResponseMsgType :: FromClientMessage -> B.ByteString -> FromServerMessage
-matchResponseMsgType req bytes = case req of
- ReqInitialize _ -> RspInitialize $ fromJust $ decode bytes
- ReqShutdown _ -> RspShutdown $ fromJust $ decode bytes
- ReqHover _ -> RspHover $ fromJust $ decode bytes
- ReqCompletion _ -> RspCompletion $ fromJust $ decode bytes
- ReqCompletionItemResolve _ ->
- RspCompletionItemResolve $ fromJust $ decode bytes
- ReqSignatureHelp _ -> RspSignatureHelp $ fromJust $ decode bytes
- ReqDefinition _ -> RspDefinition $ fromJust $ decode bytes
- ReqFindReferences _ -> RspFindReferences $ fromJust $ decode bytes
- ReqDocumentHighlights _ -> RspDocumentHighlights $ fromJust $ decode bytes
- ReqDocumentSymbols _ -> RspDocumentSymbols $ fromJust $ decode bytes
- ReqWorkspaceSymbols _ -> RspWorkspaceSymbols $ fromJust $ decode bytes
- ReqCodeAction _ -> RspCodeAction $ fromJust $ decode bytes
- ReqCodeLens _ -> RspCodeLens $ fromJust $ decode bytes
- ReqCodeLensResolve _ -> RspCodeLensResolve $ fromJust $ decode bytes
- ReqDocumentFormatting _ -> RspDocumentFormatting $ fromJust $ decode bytes
- ReqDocumentRangeFormatting _ ->
- RspDocumentRangeFormatting $ fromJust $ decode bytes
- ReqDocumentOnTypeFormatting _ ->
- RspDocumentOnTypeFormatting $ fromJust $ decode bytes
- ReqRename _ -> RspRename $ fromJust $ decode bytes
- ReqExecuteCommand _ -> RspExecuteCommand $ fromJust $ decode bytes
- ReqDocumentLink _ -> RspDocumentLink $ fromJust $ decode bytes
- ReqDocumentLinkResolve _ -> RspDocumentLinkResolve $ fromJust $ decode bytes
- ReqWillSaveWaitUntil _ -> RspWillSaveWaitUntil $ fromJust $ decode bytes
- x -> error $ "Not a request: " ++ show x
+satisfy :: (Stream s m a, Eq a, Show a) => (a -> Bool) -> ParsecT s u m a
+satisfy pred = tokenPrim show nextPos test
+ where nextPos x _ _ = x
+ test x = if pred x then Just x else Nothing
-decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
-decodeFromServerMsg reqMap bytes =
- case HM.lookup "method" (fromJust $ decode bytes :: Object) of
- Just methodStr -> case fromJSON methodStr of
- Success method -> case method of
- -- We can work out the type of the message
- TextDocumentPublishDiagnostics -> NotPublishDiagnostics $ fromJust $ decode bytes
- WindowShowMessage -> NotShowMessage $ fromJust $ decode bytes
- WindowLogMessage -> NotLogMessage $ fromJust $ decode bytes
- CancelRequestServer -> NotCancelRequestFromServer $ fromJust $ decode bytes
- TelemetryEvent -> NotTelemetry $ fromJust $ decode bytes
- WindowShowMessageRequest -> ReqShowMessage $ fromJust $ decode bytes
- ClientRegisterCapability -> ReqRegisterCapability $ fromJust $ decode bytes
- ClientUnregisterCapability -> ReqUnregisterCapability $ fromJust $ decode bytes
- WorkspaceApplyEdit -> ReqApplyWorkspaceEdit $ fromJust $ decode bytes
+testLog = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "Hello world"))
- Error e -> error e
+testSymbols = RspDocumentSymbols (ResponseMessage "2.0" (IdRspInt 0) (Just (List [])) Nothing)
- Nothing -> case decode bytes :: Maybe (ResponseMessage Value) of
- Just msg -> case HM.lookup (requestId $ msg ^. id) reqMap of
- Just req -> matchResponseMsgType req bytes -- try to decode it to more specific type
- Nothing -> error "Couldn't match up response with request"
- Nothing -> error "Couldn't decode message"
\ No newline at end of file
+parseMessages :: MessageParser a -> [FromServerMessage] -> Either ParseError a
+parseMessages parser = runP parser MessageParserState ""
\ No newline at end of file
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
-- | A testing tool for replaying captured client logs back to a server,
-- and validating that the server output matches up with another log.
module Language.Haskell.LSP.Test.Replay
import System.FilePath
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Test.Files
-import Language.Haskell.LSP.Test.Parsing
+import Language.Haskell.LSP.Test.Decoding
+import Language.Haskell.LSP.Test.Messages
-- | Replays a captured client output and
sendMessages :: [FromClientMessage] -> MVar LspId -> MVar LspIdRsp -> Session ()
sendMessages [] _ _ = return ()
sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
- case nextMsg of
- ReqInitialize m -> request m
- ReqShutdown m -> request m
- ReqHover m -> request m
- ReqCompletion m -> request m
- ReqCompletionItemResolve m -> request m
- ReqSignatureHelp m -> request m
- ReqDefinition m -> request m
- ReqFindReferences m -> request m
- ReqDocumentHighlights m -> request m
- ReqDocumentSymbols m -> request m
- ReqWorkspaceSymbols m -> request m
- ReqCodeAction m -> request m
- ReqCodeLens m -> request m
- ReqCodeLensResolve m -> request m
- ReqDocumentFormatting m -> request m
- ReqDocumentRangeFormatting m -> request m
- ReqDocumentOnTypeFormatting m -> request m
- ReqRename m -> request m
- ReqExecuteCommand m -> request m
- ReqDocumentLink m -> request m
- ReqDocumentLinkResolve m -> request m
- ReqWillSaveWaitUntil m -> request m
- RspApplyWorkspaceEdit m -> response m
- RspFromClient m -> response m
- NotInitialized m -> notification m
- NotExit m -> notification m
- NotCancelRequestFromClient m -> notification m
- NotDidChangeConfiguration m -> notification m
- NotDidOpenTextDocument m -> notification m
- NotDidChangeTextDocument m -> notification m
- NotDidCloseTextDocument m -> notification m
- NotWillSaveTextDocument m -> notification m
- NotDidSaveTextDocument m -> notification m
- NotDidChangeWatchedFiles m -> notification m
- UnknownFromClientMessage m -> liftIO $ error $ "Unknown message was recorded from the client" ++ show m
+ handleClientMessage request response notification nextMsg
where
-- TODO: May need to prevent premature exit notification being sent
notification msg@(NotificationMessage _ Exit _) = do
msgBytes <- liftIO $ getNextMessage serverOut
let msg = decodeFromServerMsg reqMap msgBytes
- case msg of
- ReqRegisterCapability m -> request m
- ReqApplyWorkspaceEdit m -> request m
- ReqShowMessage m -> request m
- ReqUnregisterCapability m -> request m
- RspInitialize m -> response m
- RspShutdown m -> response m
- RspHover m -> response m
- RspCompletion m -> response m
- RspCompletionItemResolve m -> response m
- RspSignatureHelp m -> response m
- RspDefinition m -> response m
- RspFindReferences m -> response m
- RspDocumentHighlights m -> response m
- RspDocumentSymbols m -> response m
- RspWorkspaceSymbols m -> response m
- RspCodeAction m -> response m
- RspCodeLens m -> response m
- RspCodeLensResolve m -> response m
- RspDocumentFormatting m -> response m
- RspDocumentRangeFormatting m -> response m
- RspDocumentOnTypeFormatting m -> response m
- RspRename m -> response m
- RspExecuteCommand m -> response m
- RspError m -> response m
- RspDocumentLink m -> response m
- RspDocumentLinkResolve m -> response m
- RspWillSaveWaitUntil m -> response m
- NotPublishDiagnostics m -> notification m
- NotLogMessage m -> notification m
- NotShowMessage m -> notification m
- NotTelemetry m -> notification m
- NotCancelRequestFromServer m -> notification m
+ handleServerMessage request response notification msg
if shouldSkip msg
then listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut
putMVar passVar False
where
- response :: Show a => ResponseMessage a -> Session ()
+ response :: ResponseMessage a -> Session ()
response res = do
liftIO $ putStrLn $ "Got response for id " ++ show (res ^. id)
liftIO $ putMVar rspSema (res ^. id) -- unblock the handler waiting to send a request
- request :: (Show a, Show b) => RequestMessage ServerMethod a b -> Session ()
+ request :: RequestMessage ServerMethod a b -> Session ()
request req = do
liftIO
$ putStrLn
liftIO $ putMVar reqSema (req ^. id) -- unblock the handler waiting for a response
- notification :: Show a => NotificationMessage ServerMethod a -> Session ()
+ notification :: NotificationMessage ServerMethod a -> Session ()
notification n = liftIO $ putStrLn $ "Got notification " ++ show (n ^. method)
projects / lsp-test.git / commitdiff