From 70093bf4d0c35a5639a37f1c7946bba44ac76ca6 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 14 Aug 2018 22:34:34 +0100
Subject: [PATCH] Add getCodeActions, getCurrentDiagnostics, bump

---
 ChangeLog.md                     |  5 +++++
 lsp-test.cabal                   |  2 +-
 src/Language/Haskell/LSP/Test.hs | 27 ++++++++++++++++++++++++---
 test/Test.hs                     |  7 +++++++
 4 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index ca5db5f..5a87f0d 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,10 @@
 # Revision history for lsp-test
 
+## 0.2.1.0 -- 2018-08-14
+
+* Add getCodeActions
+* Add getCurrentDiagnostics
+
 ## 0.2.0.0 -- 2018-08-06
 
 * Update to haskell-lsp 0.6.0.0
diff --git a/lsp-test.cabal b/lsp-test.cabal
index b191b6c..85ade4c 100644
--- a/lsp-test.cabal
+++ b/lsp-test.cabal
@@ -1,5 +1,5 @@
 name:                lsp-test
-version:             0.2.0.0
+version:             0.2.1.0
 synopsis:            Functional test framework for LSP servers.
 description:
   A test framework for writing tests against 
diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 04fcc21..ec290ff 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -52,9 +52,11 @@ module Language.Haskell.LSP.Test
   , waitForDiagnostics
   , waitForDiagnosticsSource
   , noDiagnostics
+  , getCurrentDiagnostics
   -- ** Commands
   , executeCommand
   -- ** Code Actions
+  , getCodeActions
   , getAllCodeActions
   , executeCodeAction
   -- ** Completions
@@ -358,15 +360,24 @@ getDocumentSymbols doc = do
     Just (DSSymbolInformation (List xs)) -> return (Right xs)
     Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse"
 
+-- | Returns the code actions in the specified range.
+getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
+getCodeActions doc range = do
+  ctx <- getCodeActionContext doc
+  rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx)
+
+  case rsp ^. result of
+    Just (List xs) -> return xs
+    _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error))
+
 -- | Returns all the code actions in a document by 
 -- querying the code actions at each of the current 
 -- diagnostics' positions.
 getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
 getAllCodeActions doc = do
-  curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
-  let ctx = CodeActionContext (List curDiags) Nothing
+  ctx <- getCodeActionContext doc
 
-  foldM (go ctx) [] curDiags
+  foldM (go ctx) [] =<< getCurrentDiagnostics doc
 
   where
     go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
@@ -379,6 +390,16 @@ getAllCodeActions doc = do
           let Just (List cmdOrCAs) = mRes
             in return (acc ++ cmdOrCAs)
 
+getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
+getCodeActionContext doc = do
+  curDiags <- getCurrentDiagnostics doc
+  return $ CodeActionContext (List curDiags) Nothing
+
+-- | Returns the current diagnostics that have been sent to the client.
+-- Note that this does not wait for more to come in.
+getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
+getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
+
 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do
diff --git a/test/Test.hs b/test/Test.hs
index d524ee4..88c6852 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -176,6 +176,13 @@ main = hspec $ do
         liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n"
         noDiagnostics
 
+  describe "getCodeActions" $
+    it "works" $ runSession "hie" fullCaps "test/data/refactor" $ do
+      doc <- openDoc "Main.hs" "haskell"
+      waitForDiagnostics
+      [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
+      liftIO $ action ^. title `shouldBe` "Apply hint:Redundant bracket"
+
   describe "getAllCodeActions" $
     it "works" $ runSession "hie --lsp" fullCaps "test/data/refactor" $ do
       doc <- openDoc "Main.hs" "haskell"
-- 
2.30.2