Limit CodeActions within passed range

Return only actions within range specified by client.

Author: aufarg

hls-plugin-api/src/Ide/PluginUtils.hs

@@ -19,7 +19,7 @@ module Ide.PluginUtils
     mkLspCommand,
     mkLspCmdId,
     getPid,
-  allLspCmdIds,allLspCmdIds',installSigUsr1Handler, subRange)
+  allLspCmdIds,allLspCmdIds',installSigUsr1Handler, subRange, overlappingRange)
 where
 
 
@@ -185,6 +185,11 @@ subRange smallRange range =
      positionInRange (_start smallRange) range
   && positionInRange (_end smallRange) range
 
+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

plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

@@ -272,16 +272,21 @@ codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right
   where
 
     getCodeActions = do
-        diags <- getDiagnostics ideState
+        allDiags <- getDiagnostics ideState
         let docNfp = toNormalizedFilePath' <$> uriToFilePath' (docId ^. LSP.uri)
             numHintsInDoc = length
-              [d | (nfp, _, d) <- diags
+              [d | (nfp, _, d) <- allDiags
                  , validCommand d
                  , Just nfp == docNfp
               ]
+            numHintsInContext = length
+              [d | d <- diags
+                 , validCommand d
+              ]
         -- We only want to show the applyAll code action if there is more than 1
-        -- hint in the current document
-        if numHintsInDoc > 1 then do
+        -- hint in the current document and if code action range contains at
+        -- least one hint
+        if numHintsInDoc > 1 && numHintsInContext > 0 then do
           pure $ applyAllAction:applyOneActions
         else
           pure applyOneActions

test/functional/FunctionalCodeAction.hs

@@ -170,6 +170,22 @@ hlintTests = testGroup "hlint suggestions" [
 
     , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do
         testRefactor "ApplyRefact6.hs" "Redundant bracket" expectedComments
+
+    , testCase "applyAll is shown only when there is at least one diagnostic in range" $  runHlintSession "" $ do
+        doc <- openDoc "ApplyRefact7.hs" "haskell"
+        _ <- waitForDiagnosticsFromSource doc "hlint"
+
+        firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 0 0)
+        secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 1 0)
+        thirdLine <- map fromAction <$> getCodeActions doc (mkRange 2 0 2 0)
+        multiLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 2 0)
+
+        let hasApplyAll = isJust . find (\ca -> "Apply all hints" `T.isSuffixOf` (ca ^. L.title))
+
+        liftIO $ hasApplyAll firstLine @? "Missing apply all code action"
+        liftIO $ hasApplyAll secondLine @? "Missing apply all code action"
+        liftIO $ not (hasApplyAll thirdLine) @? "Unexpected apply all code action"
+        liftIO $ hasApplyAll multiLine @? "Missing apply all code action"
     ]
     where
         runHlintSession :: FilePath -> Session a -> IO a

test/testdata/hlint/ApplyRefact7.hs

@@ -0,0 +1,3 @@
+f = (1)
+g = (1)
+