X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FDecoding.hs;h=059ab344dafad445003e0f066583cd779d5d79a1;hb=fa0bdbf2ca975ea2493d0fcfaa6cb63c076567c1;hp=f8d63060cd269e71ab4757eb7695cf1b36b43a33;hpb=bc52b000bf018360efbfa0fcd289329c70d2c77e;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index f8d6306..059ab34 100644
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -8,7 +8,7 @@ import qualified Data.ByteString.Lazy.Char8    as B
 import           Data.Maybe
 import           System.IO
 import           Language.Haskell.LSP.Types
-                                         hiding ( error )
+import           Language.Haskell.LSP.Types.Lens hiding (error)
 import           Language.Haskell.LSP.Messages
 import qualified Data.HashMap.Strict           as HM
 
@@ -84,30 +84,33 @@ getRequestMap = foldl helper HM.empty
   insert m = HM.insert (m ^. id) (m ^. method)
 
 matchResponseMsgType :: ClientMethod -> B.ByteString -> FromServerMessage
-matchResponseMsgType req bytes = case req of
-  Initialize                    -> RspInitialize $ fromJust $ decode bytes
-  Shutdown                      -> RspShutdown $ fromJust $ decode bytes
-  TextDocumentHover             -> RspHover $ fromJust $ decode bytes
-  TextDocumentCompletion        -> RspCompletion $ fromJust $ decode bytes
-  CompletionItemResolve         -> RspCompletionItemResolve $ fromJust $ decode bytes
-  TextDocumentSignatureHelp     -> RspSignatureHelp $ fromJust $ decode bytes
-  TextDocumentDefinition        -> RspDefinition $ fromJust $ decode bytes
-  TextDocumentReferences        -> RspFindReferences $ fromJust $ decode bytes
-  TextDocumentDocumentHighlight -> RspDocumentHighlights $ fromJust $ decode bytes
-  TextDocumentDocumentSymbol    -> RspDocumentSymbols $ fromJust $ decode bytes
-  WorkspaceSymbol               -> RspWorkspaceSymbols $ fromJust $ decode bytes
-  TextDocumentCodeAction        -> RspCodeAction $ fromJust $ decode bytes
-  TextDocumentCodeLens          -> RspCodeLens $ fromJust $ decode bytes
-  CodeLensResolve               -> RspCodeLensResolve $ fromJust $ decode bytes
-  TextDocumentFormatting        -> RspDocumentFormatting $ fromJust $ decode bytes
-  TextDocumentRangeFormatting   -> RspDocumentRangeFormatting $ fromJust $ decode bytes
-  TextDocumentOnTypeFormatting  -> RspDocumentOnTypeFormatting $ fromJust $ decode bytes
-  TextDocumentRename            -> RspRename $ fromJust $ decode bytes
-  WorkspaceExecuteCommand       -> RspExecuteCommand $ fromJust $ decode bytes
-  TextDocumentDocumentLink      -> RspDocumentLink $ fromJust $ decode bytes
-  DocumentLinkResolve           -> RspDocumentLinkResolve $ fromJust $ decode bytes
-  TextDocumentWillSaveWaitUntil -> RspWillSaveWaitUntil $ fromJust $ decode bytes
-  x                             -> error $ "Not a request: " ++ show x
+matchResponseMsgType req = case req of
+  Initialize                    -> RspInitialize . decoded
+  Shutdown                      -> RspShutdown . decoded
+  TextDocumentHover             -> RspHover . decoded
+  TextDocumentCompletion        -> RspCompletion . decoded
+  CompletionItemResolve         -> RspCompletionItemResolve . decoded
+  TextDocumentSignatureHelp     -> RspSignatureHelp . decoded
+  TextDocumentDefinition        -> RspDefinition . decoded
+  TextDocumentReferences        -> RspFindReferences . decoded
+  TextDocumentDocumentHighlight -> RspDocumentHighlights . decoded
+  TextDocumentDocumentSymbol    -> RspDocumentSymbols . decoded
+  WorkspaceSymbol               -> RspWorkspaceSymbols . decoded
+  TextDocumentCodeAction        -> RspCodeAction . decoded
+  TextDocumentCodeLens          -> RspCodeLens . decoded
+  CodeLensResolve               -> RspCodeLensResolve . decoded
+  TextDocumentFormatting        -> RspDocumentFormatting . decoded
+  TextDocumentRangeFormatting   -> RspDocumentRangeFormatting . decoded
+  TextDocumentOnTypeFormatting  -> RspDocumentOnTypeFormatting . decoded
+  TextDocumentRename            -> RspRename . decoded
+  WorkspaceExecuteCommand       -> RspExecuteCommand . decoded
+  TextDocumentDocumentLink      -> RspDocumentLink . decoded
+  DocumentLinkResolve           -> RspDocumentLinkResolve . decoded
+  TextDocumentWillSaveWaitUntil -> RspWillSaveWaitUntil . 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)
 
 decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
 decodeFromServerMsg reqMap bytes =
@@ -124,6 +127,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