From: Luke Lau <luke_lau@icloud.com>
Date: Thu, 13 Jun 2019 00:36:22 +0000 (+0100)
Subject: Merge pull request #40 from cocreature/fix-custom-methods
X-Git-Tag: 0.5.4.0~1
X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=23447141213d07c7d290574f5fd6e8c58b346c8f;hp=16a5bfa7178489684467af6349f620ef84dc755a

Merge pull request #40 from cocreature/fix-custom-methods

Adapt to custom methods changes in haskell-lsp
---

diff --git a/lsp-test.cabal b/lsp-test.cabal
index f1035b2..f5b8f97 100644
--- a/lsp-test.cabal
+++ b/lsp-test.cabal
@@ -1,5 +1,5 @@
 name:                lsp-test
-version:             0.5.2.3
+version:             0.5.3.0
 synopsis:            Functional test framework for LSP servers.
 description:
   A test framework for writing tests against
@@ -36,7 +36,7 @@ library
                      , parser-combinators:Control.Applicative.Combinators
   default-language:    Haskell2010
   build-depends:       base >= 4.10 && < 5
-                     , haskell-lsp >= 0.13.0 && < 0.14
+                     , haskell-lsp == 0.14.*
                      , aeson
                      , aeson-pretty
                      , ansi-terminal
@@ -79,7 +79,7 @@ test-suite tests
   build-depends:       base >= 4.10 && < 5
                      , hspec
                      , lens
-                     , haskell-lsp >= 0.13.0 && < 0.14
+                     , haskell-lsp == 0.14.*
                      , lsp-test
                      , data-default
                      , aeson
diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index 337dee3..27c7770 100644
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -123,7 +123,7 @@ matchResponseMsgType req = case req of
 
 decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
 decodeFromServerMsg reqMap bytes =
-  case HM.lookup "method" (fromJust $ decode bytes :: Object) of
+  case HM.lookup "method" obj of
     Just methodStr -> case fromJSON methodStr of
       Success method -> case method of
         -- We can work out the type of the message
@@ -141,6 +141,10 @@ decodeFromServerMsg reqMap bytes =
         WorkspaceApplyEdit             -> ReqApplyWorkspaceEdit $ fromJust $ decode bytes
         WorkspaceWorkspaceFolders      -> error "ReqWorkspaceFolders not supported yet"
         WorkspaceConfiguration         -> error "ReqWorkspaceConfiguration not supported yet"
+        CustomServerMethod _
+            | "id" `HM.member` obj && "method" `HM.member` obj -> ReqCustomServer $ fromJust $ decode bytes
+            | "id" `HM.member` obj -> RspCustomServer $ fromJust $ decode bytes
+            | otherwise -> NotCustomServer $ fromJust $ decode bytes
 
       Error e -> error e
 
@@ -149,3 +153,4 @@ decodeFromServerMsg reqMap bytes =
         Just req -> matchResponseMsgType req bytes -- try to decode it to more specific type
         Nothing  -> error "Couldn't match up response with request"
       Nothing -> error "Couldn't decode message"
+    where obj = fromJust $ decode bytes :: Object
diff --git a/src/Language/Haskell/LSP/Test/Messages.hs b/src/Language/Haskell/LSP/Test/Messages.hs
index 1a3805f..16813e2 100644
--- a/src/Language/Haskell/LSP/Test/Messages.hs
+++ b/src/Language/Haskell/LSP/Test/Messages.hs
@@ -59,6 +59,7 @@ handleServerMessage request response notification msg = case msg of
     (ReqApplyWorkspaceEdit       m) -> request m
     (ReqShowMessage              m) -> request m
     (ReqUnregisterCapability     m) -> request m
+    (ReqCustomServer             m) -> request m
     (RspInitialize               m) -> response m
     (RspShutdown                 m) -> response m
     (RspHover                    m) -> response m
@@ -87,6 +88,7 @@ handleServerMessage request response notification msg = case msg of
     (RspDocumentColor            m) -> response m
     (RspColorPresentation        m) -> response m
     (RspFoldingRange             m) -> response m
+    (RspCustomServer             m) -> response m
     (NotPublishDiagnostics       m) -> notification m
     (NotLogMessage               m) -> notification m
     (NotShowMessage              m) -> notification m
@@ -95,6 +97,7 @@ handleServerMessage request response notification msg = case msg of
     (NotProgressDone             m) -> notification m
     (NotTelemetry                m) -> notification m
     (NotCancelRequestFromServer  m) -> notification m
+    (NotCustomServer             m) -> notification m
 
 handleClientMessage
     :: forall a.
@@ -145,4 +148,5 @@ handleClientMessage request response notification msg = case msg of
  (NotDidChangeWatchedFiles    m) -> notification m
  (NotDidChangeWorkspaceFolders m) -> notification m
  (NotProgressCancel           m) -> notification m
- (UnknownFromClientMessage    m) -> error $ "Unknown message sent from client: " ++ show m
+ (ReqCustomClient             m) -> request m
+ (NotCustomClient             m) -> notification m
diff --git a/stack.yaml b/stack.yaml
index 9790aba..502afa8 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -3,6 +3,6 @@ packages:
   - .
 
 extra-deps:
-  - haskell-lsp-0.13.0.0
-  - haskell-lsp-types-0.13.0.0
+  - haskell-lsp-0.14.0.0
+  - haskell-lsp-types-0.14.0.0
   - rope-utf16-splay-0.3.1.0