X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=8805976c3dedcaef8be8c88fd06c904f1d6b0c36;hb=ddf9bc17ce8a548a927c201c6b0edb8cf1c9fcad;hp=52c84a4168080e7b687d0a67b8859c2a4a964885;hpb=6f031f598fdccd1b85b8086ac2d07b41e8ef896a;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index 52c84a4..8805976 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 @@ -120,7 +120,6 @@ 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 = @@ -132,9 +131,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