From 00b1ef8e80a40291e13b07ffe20a891a768c2439 Mon Sep 17 00:00:00 2001
From: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
Date: Tue, 4 Jun 2019 11:21:19 +0200
Subject: [PATCH] Adapt to custom methods changes in haskell-lsp

---
 cabal.project                             | 11 +++++++++++
 src/Language/Haskell/LSP/Test/Decoding.hs |  7 ++++++-
 src/Language/Haskell/LSP/Test/Messages.hs |  6 +++++-
 stack.yaml                                |  7 +++++--
 4 files changed, 27 insertions(+), 4 deletions(-)
 create mode 100644 cabal.project

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
-- 
2.30.2