X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=8805976c3dedcaef8be8c88fd06c904f1d6b0c36;hb=ddf9bc17ce8a548a927c201c6b0edb8cf1c9fcad;hp=27c7770ec461cdebe16a17868419b440f986081a;hpb=23447141213d07c7d290574f5fd6e8c58b346c8f;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index 27c7770..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 @@ -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 @@ -131,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