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

diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index 52c84a4..350b525 100644
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -3,6 +3,7 @@ module Language.Haskell.LSP.Test.Decoding where
 
 import           Prelude                 hiding ( id )
 import           Data.Aeson
+import           Data.Foldable
 import           Control.Exception
 import           Control.Lens
 import qualified Data.ByteString.Lazy.Char8    as B
@@ -11,7 +12,6 @@ import           System.IO
 import           System.IO.Error
 import           Language.Haskell.LSP.Types
 import           Language.Haskell.LSP.Types.Lens
-                                         hiding ( error )
 import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Test.Exceptions
 import qualified Data.HashMap.Strict           as HM
@@ -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 . removeNullResult
+  Shutdown                      -> RspShutdown . decoded
   TextDocumentHover             -> RspHover . decoded
   TextDocumentCompletion        -> RspCompletion . decoded
   CompletionItemResolve         -> RspCompletionItemResolve . decoded
@@ -116,11 +116,11 @@ matchResponseMsgType req = case req of
   TextDocumentDocumentLink      -> RspDocumentLink . decoded
   DocumentLinkResolve           -> RspDocumentLinkResolve . decoded
   TextDocumentWillSaveWaitUntil -> RspWillSaveWaitUntil . decoded
+  CustomClientMethod{}          -> RspCustomServer . decoded
   x                             -> error . ((show x ++ " is not a request: ") ++) . show
   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 =
@@ -132,9 +132,9 @@ decodeFromServerMsg reqMap bytes =
         WindowShowMessage              -> NotShowMessage $ fromJust $ decode bytes
         WindowLogMessage               -> NotLogMessage $ fromJust $ decode bytes
         CancelRequestServer            -> NotCancelRequestFromServer $ fromJust $ decode bytes
-        WindowProgressStart            -> NotProgressStart $ fromJust $ decode bytes
-        WindowProgressReport           -> NotProgressReport $ fromJust $ decode bytes
-        WindowProgressDone             -> NotProgressDone $ fromJust $ decode bytes
+        Progress                       ->
+          fromJust $ asum [NotWorkDoneProgressBegin <$> decode bytes, NotWorkDoneProgressReport <$> decode bytes, NotWorkDoneProgressEnd <$> decode bytes]
+        WindowWorkDoneProgressCreate   -> ReqWorkDoneProgressCreate $ fromJust $ decode bytes
         TelemetryEvent                 -> NotTelemetry $ fromJust $ decode bytes
         WindowShowMessageRequest       -> ReqShowMessage $ fromJust $ decode bytes
         ClientRegisterCapability       -> ReqRegisterCapability $ fromJust $ decode bytes