Search infix hole directly in file text

haskell · Jun 9, 2024 · b67871e · b67871e
1 parent ac748c4
commit b67871e
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 4 deletions.
diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs
@@ -27,7 +27,8 @@ module Development.IDE.GHC.Util(
     dontWriteHieFiles,
     disableWarningsAsErrors,
     printOutputable,
-    getExtensions
+    getExtensions,
+    textInRange
     ) where
 
 import           Control.Concurrent
@@ -272,3 +273,21 @@ printOutputable =
 
 getExtensions :: ParsedModule -> [Extension]
 getExtensions = toList . extensionFlags . ms_hspp_opts . pm_mod_summary
+
+-- | Returns [start .. end[
+textInRange :: Range -> T.Text -> T.Text
+textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCol)) (Position (fromIntegral -> endRow) (fromIntegral -> endCol))) text =
+    case compare startRow endRow of
+      LT ->
+        let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine
+            (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of
+              [] -> ("", [])
+              firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)
+            maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines
+        in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)
+      EQ ->
+        let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)
+        in T.take (endCol - startCol) (T.drop startCol line)
+      GT -> ""
+    where
+      linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/FillHole.hs
@@ -5,22 +5,26 @@ module Development.IDE.Plugin.Plugins.FillHole
 import           Control.Monad                             (guard)
 import           Data.Char
 import qualified Data.Text                                 as T
+import           Development.IDE.GHC.Util                  (textInRange)
 import           Development.IDE.Plugin.Plugins.Diagnostic
 import           Language.LSP.Protocol.Types               (Diagnostic (..),
                                                             TextEdit (TextEdit))
 import           Text.Regex.TDFA                           (MatchResult (..),
                                                             (=~))
 
-suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)]
-suggestFillHole Diagnostic{_range=_range,..}
+suggestFillHole :: Maybe T.Text -> Diagnostic -> [(T.Text, TextEdit)]
+suggestFillHole contents Diagnostic{_range=_range,..}
     | Just holeName <- extractHoleName _message
     , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) =
-      let isInfixHole = _message =~ addBackticks holeName :: Bool in
+      let isInfixHole = textInDiagnosticRange =~ addBackticks holeName :: Bool in
         map (proposeHoleFit holeName False isInfixHole) holeFits
         ++ map (proposeHoleFit holeName True isInfixHole) refFits
     | otherwise = []
     where
       extractHoleName = fmap (headOrThrow "impossible") . flip matchRegexUnifySpaces "Found hole: ([^ ]*)"
+      textInDiagnosticRange = case contents of
+        Nothing -> ""
+        Just text -> textInRange _range text
       addBackticks text = "`" <> text <> "`"
       addParens text = "(" <> text <> ")"
       proposeHoleFit holeName parenthise isInfixHole name =