getNextMessage h = do
headers <- getHeaders h
case read . init <$> lookup "Content-Length" headers of
- Nothing -> error "Couldn't read Content-Length header"
+ Nothing -> throw NoContentLengthHeader
Just size -> B.hGet h size
addHeader :: B.ByteString -> B.ByteString
matchResponseMsgType :: ClientMethod -> B.ByteString -> FromServerMessage
matchResponseMsgType req = case req of
Initialize -> RspInitialize . decoded
- Shutdown -> RspShutdown . decoded
+ Shutdown -> RspShutdown . decoded . removeNullResult
TextDocumentHover -> RspHover . decoded
TextDocumentCompletion -> RspCompletion . decoded
CompletionItemResolve -> RspCompletionItemResolve . decoded
where decoded x = fromMaybe (error $ "Couldn't decode response for the request type: "
++ show req ++ "\n" ++ show x)
(decode x)
+ removeNullResult x = maybe x (<> "}") (B.stripSuffix ",\"result\":null}" x)
decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
decodeFromServerMsg reqMap bytes =
- case HM.lookup "method" (fromJust $ decode bytes :: Object) of
+ case HM.lookup "method" obj of
Just methodStr -> case fromJSON methodStr of
Success method -> case method of
-- We can work out the type of the message
WindowProgressStart -> NotProgressStart $ fromJust $ decode bytes
WindowProgressReport -> NotProgressReport $ fromJust $ decode bytes
WindowProgressDone -> NotProgressDone $ fromJust $ decode bytes
- WindowProgressCancel -> NotProgressCancel $ fromJust $ decode bytes
TelemetryEvent -> NotTelemetry $ fromJust $ decode bytes
WindowShowMessageRequest -> ReqShowMessage $ fromJust $ decode bytes
ClientRegisterCapability -> ReqRegisterCapability $ fromJust $ decode bytes
WorkspaceApplyEdit -> ReqApplyWorkspaceEdit $ fromJust $ decode bytes
WorkspaceWorkspaceFolders -> error "ReqWorkspaceFolders not supported yet"
WorkspaceConfiguration -> error "ReqWorkspaceConfiguration not supported yet"
+ CustomServerMethod _
+ | "id" `HM.member` obj && "method" `HM.member` obj -> ReqCustomServer $ fromJust $ decode bytes
+ | "id" `HM.member` obj -> RspCustomServer $ fromJust $ decode bytes
+ | otherwise -> NotCustomServer $ fromJust $ decode bytes
Error e -> error e
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"
+ where obj = fromJust $ decode bytes :: Object