From: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
Date: Tue, 4 Jun 2019 09:21:19 +0000 (+0200)
Subject: Adapt to custom methods changes in haskell-lsp
X-Git-Tag: 0.5.4.0~1^2~1
X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=00b1ef8e80a40291e13b07ffe20a891a768c2439

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

diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..ac9b511
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,11 @@
+packages:
+  ./.
+source-repository-package
+  type: git
+  location: https://github.com/alanz/haskell-lsp.git
+  tag: 491d8d2e33572b3868078f57a3375b2ac621f958
+source-repository-package
+  type: git
+  location: https://github.com/alanz/haskell-lsp.git
+  tag: 491d8d2e33572b3868078f57a3375b2ac621f958
+  subdir: haskell-lsp-types
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..855f4e9 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -3,6 +3,9 @@ packages:
   - .
 
 extra-deps:
-  - haskell-lsp-0.13.0.0
-  - haskell-lsp-types-0.13.0.0
+  - git: https://github.com/alanz/haskell-lsp.git
+    commit: 491d8d2e33572b3868078f57a3375b2ac621f958
+    subdirs:
+      - .
+      - haskell-lsp-types
   - rope-utf16-splay-0.3.1.0