-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
+decodeFromServerMsg :: RequestMap -> B.ByteString -> (RequestMap, FromServerMessage)
+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) = (reqMap, FromServerMess m msg)
+ unP (FromServerRsp (Pair m (Const newMap)) msg) = (newMap, FromServerRsp m msg)
+ {-
+ 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