Limit diagnostics by range in getCodeActions

Author: aufarg

lsp-test/src/Language/LSP/Test.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 {-|
 Module      : Language.LSP.Test
@@ -501,7 +502,7 @@ getDocumentSymbols doc = do
 -- | Returns the code actions in the specified range.
 getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
 getCodeActions doc range = do
-  ctx <- getCodeActionContext doc
+  ctx <- getCodeActionContextInRange doc range
   rsp <- request STextDocumentCodeAction (CodeActionParams Nothing Nothing doc range ctx)
 
   case rsp ^. result of
@@ -526,6 +527,26 @@ getAllCodeActions doc = do
         Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
         Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs)
 
+getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
+getCodeActionContextInRange doc caRange = do
+  curDiags <- getCurrentDiagnostics doc
+  let diags = [ d | d@Diagnostic{_range=range} <- curDiags
+                  , overlappingRange caRange range
+              ]
+  return $ CodeActionContext (List diags) Nothing
+  where
+    overlappingRange :: Range -> Range -> Bool
+    overlappingRange (Range s e) range =
+         positionInRange s range
+      || positionInRange e range
+
+    positionInRange :: Position -> Range -> Bool
+    positionInRange (Position pl po) (Range (Position sl so) (Position el eo)) =
+         pl >  sl && pl <  el
+      || pl == sl && pl == el && po >= so && po <= eo
+      || pl == sl && po >= so
+      || pl == el && po <= eo
+
 getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
 getCodeActionContext doc = do
   curDiags <- getCurrentDiagnostics doc

lsp-test/test/Test.hs

@@ -161,8 +161,10 @@ main = findServer >>= \serverExe -> hspec $ do
     it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do
       doc <- openDoc "Main.hs" "haskell"
       waitForDiagnostics
-      [InR action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
+      [InR action] <- getCodeActions doc (Range (Position 0 0) (Position 0 2))
+      actions <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
       liftIO $ action ^. title `shouldBe` "Delete this"
+      liftIO $ actions `shouldSatisfy` null
 
   describe "getAllCodeActions" $
     it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do