X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=52c84a4168080e7b687d0a67b8859c2a4a964885;hb=6f031f598fdccd1b85b8086ac2d07b41e8ef896a;hp=337dee371db5ae67cbe3f898e1f8401a4d05609a;hpb=0033204f40889a5ed1736777ffe71d26b7a0d307;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index 337dee3..52c84a4 100644
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -32,7 +32,7 @@ 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"
+    Nothing   -> throw NoContentLengthHeader
     Just size -> B.hGet h size
 
 addHeader :: B.ByteString -> B.ByteString
@@ -94,7 +94,7 @@ getRequestMap = foldl helper HM.empty
 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
@@ -120,10 +120,11 @@ matchResponseMsgType req = case req of
   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
@@ -141,6 +142,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 +154,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