X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=77567349053e86cce1b52e873032b8a7f3028022;hb=d9e5c22f6c996a74ac8a4daca0e64003798a723d;hp=5d0a64b6429aed3a20cba013a9ccf8fa1cfb70a4;hpb=edee40c4aba2607c652cace2da780c373612665f;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index 5d0a64b..7756734 100644 --- a/src/Language/Haskell/LSP/Test/Decoding.hs +++ b/src/Language/Haskell/LSP/Test/Decoding.hs @@ -3,13 +3,17 @@ module Language.Haskell.LSP.Test.Decoding where import Prelude hiding ( id ) import Data.Aeson +import Control.Exception import Control.Lens import qualified Data.ByteString.Lazy.Char8 as B import Data.Maybe 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 getAllMessages :: Handle -> IO [B.ByteString] @@ -42,9 +46,12 @@ addHeader content = B.concat getHeaders :: Handle -> IO [(String, String)] getHeaders h = do - l <- hGetLine h + l <- catch (hGetLine h) eofHandler let (name, val) = span (/= ':') l if null val then return [] else ((name, drop 2 val) :) <$> getHeaders h + where eofHandler e + | isEOFError e = throw UnexpectedServerTermination + | otherwise = throw e type RequestMap = HM.HashMap LspId ClientMethod @@ -127,6 +134,8 @@ decodeFromServerMsg reqMap bytes = ClientRegisterCapability -> ReqRegisterCapability $ fromJust $ decode bytes ClientUnregisterCapability -> ReqUnregisterCapability $ fromJust $ decode bytes WorkspaceApplyEdit -> ReqApplyWorkspaceEdit $ fromJust $ decode bytes + WorkspaceWorkspaceFolders -> error "ReqWorkspaceFolders not supported yet" + WorkspaceConfiguration -> error "ReqWorkspaceConfiguration not supported yet" Error e -> error e