X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=27c7770ec461cdebe16a17868419b440f986081a;hp=337dee371db5ae67cbe3f898e1f8401a4d05609a;hb=00b1ef8e80a40291e13b07ffe20a891a768c2439;hpb=66d495a95570769fcdd8d65b0e634aaa6a77131b diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index 337dee3..27c7770 100644 --- a/src/Language/Haskell/LSP/Test/Decoding.hs +++ b/src/Language/Haskell/LSP/Test/Decoding.hs @@ -123,7 +123,7 @@ matchResponseMsgType req = case req of 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 @@ -141,6 +141,10 @@ decodeFromServerMsg reqMap 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 @@ -149,3 +153,4 @@ decodeFromServerMsg reqMap bytes = 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