-matchResponseMsgType :: ClientMethod -> B.ByteString -> FromServerMessage
-matchResponseMsgType req bytes = case req of
- Initialize -> RspInitialize $ fromJust $ decode bytes
- Shutdown -> RspShutdown $ fromJust $ decode bytes
- TextDocumentHover -> RspHover $ fromJust $ decode bytes
- TextDocumentCompletion -> RspCompletion $ fromJust $ decode bytes
- CompletionItemResolve -> RspCompletionItemResolve $ fromJust $ decode bytes
- TextDocumentSignatureHelp -> RspSignatureHelp $ fromJust $ decode bytes
- TextDocumentDefinition -> RspDefinition $ fromJust $ decode bytes
- TextDocumentReferences -> RspFindReferences $ fromJust $ decode bytes
- TextDocumentDocumentHighlight -> RspDocumentHighlights $ fromJust $ decode bytes
- TextDocumentDocumentSymbol -> RspDocumentSymbols $ fromJust $ decode bytes
- WorkspaceSymbol -> RspWorkspaceSymbols $ fromJust $ decode bytes
- TextDocumentCodeAction -> RspCodeAction $ fromJust $ decode bytes
- TextDocumentCodeLens -> RspCodeLens $ fromJust $ decode bytes
- CodeLensResolve -> RspCodeLensResolve $ fromJust $ decode bytes
- TextDocumentFormatting -> RspDocumentFormatting $ fromJust $ decode bytes
- TextDocumentRangeFormatting -> RspDocumentRangeFormatting $ fromJust $ decode bytes
- TextDocumentOnTypeFormatting -> RspDocumentOnTypeFormatting $ fromJust $ decode bytes
- TextDocumentRename -> RspRename $ fromJust $ decode bytes
- WorkspaceExecuteCommand -> RspExecuteCommand $ fromJust $ decode bytes
- TextDocumentDocumentLink -> RspDocumentLink $ fromJust $ decode bytes
- DocumentLinkResolve -> RspDocumentLinkResolve $ fromJust $ decode bytes
- TextDocumentWillSaveWaitUntil -> 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
+decodeFromServerMsg :: RequestMap -> B.ByteString -> (FromServerMessage, RequestMap)
+decodeFromServerMsg reqMap bytes = unP $ fromJust $ parseMaybe p obj
+ where obj = fromJust $ decode bytes :: Value
+ p = parseServerMessage $ \lid ->
+ let (mm, newMap) = pickFromIxMap lid reqMap
+ in case mm of
+ Nothing -> Nothing
+ Just m -> Just $ (m, Pair m (Const newMap))
+ unP (FromServerMess m msg) = (FromServerMess m msg, reqMap)
+ unP (FromServerRsp (Pair m (Const newMap)) msg) = (FromServerRsp m msg, newMap)
+ {-
+ 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