X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=43810bbe7c28fa95e47a7795d65190a8598fc42f;hb=5822dd40ae06ed413727cfeb3d1fd24b285db9e5;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..43810bb 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
 
@@ -65,6 +72,7 @@ getRequestMap = foldl helper HM.empty
     (ReqCompletionItemResolve val) -> insert val acc
     (ReqSignatureHelp val) -> insert val acc
     (ReqDefinition val) -> insert val acc
+    (ReqTypeDefinition val) -> insert val acc
     (ReqFindReferences val) -> insert val acc
     (ReqDocumentHighlights val) -> insert val acc
     (ReqDocumentSymbols val) -> insert val acc
@@ -92,6 +100,7 @@ matchResponseMsgType req = case req of
   CompletionItemResolve         -> RspCompletionItemResolve . decoded
   TextDocumentSignatureHelp     -> RspSignatureHelp . decoded
   TextDocumentDefinition        -> RspDefinition . decoded
+  TextDocumentTypeDefinition    -> RspTypeDefinition . decoded
   TextDocumentReferences        -> RspFindReferences . decoded
   TextDocumentDocumentHighlight -> RspDocumentHighlights . decoded
   TextDocumentDocumentSymbol    -> RspDocumentSymbols . decoded
@@ -122,11 +131,17 @@ 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
+        WindowProgressCancel           -> NotProgressCancel $ fromJust $ decode bytes
         TelemetryEvent                 -> NotTelemetry $ fromJust $ decode bytes
         WindowShowMessageRequest       -> ReqShowMessage $ fromJust $ decode 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