From d407fcb824651008604c913f5071f502d9a741bd Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 6 Sep 2025 11:01:40 +0200 Subject: [PATCH 1/7] Add levenshtein scoring function --- ghcide/ghcide.cabal | 2 ++ ghcide/src/Text/Fuzzy/Levenshtein.hs | 36 ++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100644 ghcide/src/Text/Fuzzy/Levenshtein.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 7dd12f9fef..540e902b69 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -83,6 +83,7 @@ library , list-t , lsp ^>=2.7 , lsp-types ^>=2.3 + , MemoTrie , mtl , opentelemetry >=0.6.1 , optparse-applicative @@ -196,6 +197,7 @@ library Development.IDE.Types.Shake Generics.SYB.GHC Text.Fuzzy.Parallel + Text.Fuzzy.Levenshtein other-modules: Development.IDE.Core.FileExists diff --git a/ghcide/src/Text/Fuzzy/Levenshtein.hs b/ghcide/src/Text/Fuzzy/Levenshtein.hs new file mode 100644 index 0000000000..df097b9d74 --- /dev/null +++ b/ghcide/src/Text/Fuzzy/Levenshtein.hs @@ -0,0 +1,36 @@ +module Text.Fuzzy.Levenshtein where + +import Data.Function (fix) +import Data.List (sortOn) +import Data.MemoTrie +import qualified Data.Text as T +import qualified Data.Text.Array as T +import Data.Text.Internal (Text (..)) +import Text.Fuzzy.Parallel + +-- | Same caveats apply w.r.t. ASCII as in 'Text.Fuzzy.Parallel'. +-- Might be worth optimizing this at some point, but it's good enoughᵗᵐ for now +levenshtein :: Text -> Text -> Int +levenshtein a b | T.null a = T.length b +levenshtein a b | T.null b = T.length a +levenshtein (Text aBuf aOff aLen) (Text bBuf bOff bLen) = do + let aTot = aOff + aLen + bTot = bOff + bLen + go' _ (!aIx, !bIx) | aIx >= aTot || bIx >= bTot = max (aTot - aIx) (bTot - bIx) + go' f (!aIx, !bIx) | T.unsafeIndex aBuf aIx == T.unsafeIndex bBuf bIx = f (aIx + 1, bIx + 1) + go' f (!aIx, !bIx) = + minimum + [ 2 + f (aIx + 1, bIx + 1), -- Give substitutions a heavier cost, so multiple typos cost more + 1 + f (aIx + 1, bIx), + 1 + f (aIx, bIx + 1) + ] + go = fix (memo . go') + go (aOff, bOff) + +-- | Sort the given list according to it's levenshtein distance relative to the +-- given string. +levenshteinScored :: Int -> Text -> [Text] -> [Scored Text] +levenshteinScored chunkSize needle haystack = + sortOn score $ + matchPar chunkSize needle haystack id $ + \a b -> Just $ levenshtein a b From 76ccaf3f614fe613f01720e23ec7d549ca4025b3 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 6 Sep 2025 11:01:40 +0200 Subject: [PATCH 2/7] Split off parallel matching from filtering --- ghcide/src/Text/Fuzzy/Parallel.hs | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 4d7a1d67e0..3a0ea8e9dd 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -1,10 +1,10 @@ -- | Parallel versions of 'filter' and 'simpleFilter' module Text.Fuzzy.Parallel -( filter, filter', +( filter, filter', matchPar, simpleFilter, simpleFilter', match, defChunkSize, defMaxResults, - Scored(..) + Scored(..), Matcher (..) ) where import Control.Parallel.Strategies (evalList, parList, rseq, using) @@ -18,6 +18,8 @@ import Prelude hiding (filter) data Scored a = Scored {score :: !Int, original:: !a} deriving (Functor, Show) +newtype Matcher a = Matcher { runMatcher :: T.Text -> [T.Text] -> [Scored a] } + -- | Returns the rendered output and the -- matching score for a pattern and a text. -- Two examples are given below: @@ -103,15 +105,29 @@ filter' :: Int -- ^ Chunk size. 1000 works well. -- ^ Custom scoring function to use for calculating how close words are -- When the function returns Nothing, this means the values are incomparable. -> [Scored t] -- ^ The list of results, sorted, highest score first. -filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore (concat vss) +filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore $ + matchPar chunkSize pat' ts extract match' where - -- Preserve case for the first character, make all others lowercase - pat' = case T.uncons pat of + perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat pat + -- Preserve case for the first character, make all others lowercase + pat' = case T.uncons pat of Just (c, rest) -> T.cons c (T.toLower rest) _ -> pat - vss = map (mapMaybe (\t -> flip Scored t <$> match' pat' (extract t))) (chunkList chunkSize ts) + +matchPar + :: Int -- ^ Chunk size. 1000 works well. + -> T.Text -- ^ Pattern. + -> [t] -- ^ The list of values containing the text to search in. + -> (t -> T.Text) -- ^ The function to extract the text from the container. + -> (T.Text -> T.Text -> Maybe Int) + -- ^ Custom scoring function to use for calculating how close words are + -- When the function returns Nothing, this means the values are incomparable. + -> [Scored t] -- ^ The list of results, sorted, highest score first. +{-# INLINABLE matchPar #-} +matchPar chunkSize pat ts extract match' = concat vss + where + vss = map (mapMaybe (\t -> flip Scored t <$> match' pat (extract t))) (chunkList chunkSize ts) `using` parList (evalList rseq) - perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat' pat' -- | The function to filter a list of values by fuzzy search on the text extracted from them, -- using a custom matching function which determines how close words are. From 50d447d05840b07542f1006dbb99444d9054b622 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 6 Sep 2025 11:01:40 +0200 Subject: [PATCH 3/7] Allow varying the matcher used in completions --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 22 +++++++++++++++---- .../Cabal/Completion/Completer/Module.hs | 17 ++++++++------ .../Cabal/Completion/Completer/Simple.hs | 5 +++-- .../Cabal/Completion/Completer/Types.hs | 6 ++++- 4 files changed, 36 insertions(+), 14 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7a2c53ee25..c961a914d9 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -55,6 +55,8 @@ import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS +import qualified Text.Fuzzy.Levenshtein as Fuzzy +import qualified Text.Fuzzy.Parallel as Fuzzy import Text.Regex.TDFA data Log @@ -234,7 +236,9 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo - completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields + completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields $ + Fuzzy.Matcher $ + Fuzzy.levenshteinScored Fuzzy.defChunkSize let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range @@ -365,12 +369,21 @@ completion recorder ide _ complParams = do Just (fields, _) -> do let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo - let res = computeCompletionsAt recorder ide cabalPrefInfo path fields + res = computeCompletionsAt recorder ide cabalPrefInfo path fields $ + Fuzzy.Matcher $ + Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults liftIO $ fmap InL res Nothing -> pure . InR $ InR Null -computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem] -computeCompletionsAt recorder ide prefInfo fp fields = do +computeCompletionsAt + :: Recorder (WithPriority Log) + -> IdeState + -> Types.CabalPrefixInfo + -> FilePath + -> [Syntax.Field Syntax.Position] + -> Fuzzy.Matcher T.Text + -> IO [CompletionItem] +computeCompletionsAt recorder ide prefInfo fp fields matcher = do runMaybeT (context fields) >>= \case Nothing -> pure [] Just ctx -> do @@ -390,6 +403,7 @@ computeCompletionsAt recorder ide prefInfo fp fields = do case fst ctx of Types.Stanza _ name -> name _ -> Nothing + , matcher = matcher } completions <- completer completerRecorder completerData pure completions diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs index 21dfbb9e1f..b63d225a98 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -33,8 +33,7 @@ modulesCompleter extractionFunction recorder cData = do case mGPD of Just gpd -> do let sourceDirs = extractionFunction sName gpd - filePathCompletions <- - filePathsForExposedModules recorder sourceDirs prefInfo + filePathCompletions <- filePathsForExposedModules recorder sourceDirs prefInfo (matcher cData) pure $ map (\compl -> mkSimpleCompletionItem (completionRange prefInfo) compl) filePathCompletions Nothing -> do logWith recorder Debug LogUseWithStaleFastNoResult @@ -45,8 +44,13 @@ modulesCompleter extractionFunction recorder cData = do -- | Takes a list of source directories and returns a list of path completions -- relative to any of the passed source directories which fit the passed prefix info. -filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [T.Text] -filePathsForExposedModules recorder srcDirs prefInfo = do +filePathsForExposedModules + :: Recorder (WithPriority Log) + -> [FilePath] + -> CabalPrefixInfo + -> Fuzzy.Matcher T.Text + -> IO [T.Text] +filePathsForExposedModules recorder srcDirs prefInfo matcher = do concatForM srcDirs ( \dir' -> do @@ -55,9 +59,8 @@ filePathsForExposedModules recorder srcDirs prefInfo = do completions <- listFileCompletions recorder pathInfo validExposedCompletions <- filterM (isValidExposedModulePath pathInfo) completions let toMatch = pathSegment pathInfo - scored = Fuzzy.simpleFilter - Fuzzy.defChunkSize - Fuzzy.defMaxResults + scored = Fuzzy.runMatcher + matcher toMatch (map T.pack validExposedCompletions) forM diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs index b097af5cd2..b0a24ecc48 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs @@ -41,7 +41,7 @@ errorNoopCompleter l recorder _ = do constantCompleter :: [T.Text] -> Completer constantCompleter completions _ cData = do let prefInfo = cabalPrefixInfo cData - scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) completions + scored = Fuzzy.runMatcher (matcher cData) (completionPrefix prefInfo) completions range = completionRange prefInfo pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored @@ -68,7 +68,7 @@ importCompleter l cData = do -- it is just forbidden on hackage. nameCompleter :: Completer nameCompleter _ cData = do - let scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) [completionFileName prefInfo] + let scored = Fuzzy.runMatcher (matcher cData) (completionPrefix prefInfo) [completionFileName prefInfo] prefInfo = cabalPrefixInfo cData range = completionRange prefInfo pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored @@ -85,6 +85,7 @@ weightedConstantCompleter completions weights _ cData = do let scored = if perfectScore > 0 then + -- TODO: Would be nice to use to be able to use the matcher in `cData` fmap Fuzzy.original $ Fuzzy.simpleFilter' Fuzzy.defChunkSize Fuzzy.defMaxResults prefix completions customMatch else topTenByWeight diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs index 968b68919b..74bfa1ab7e 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs @@ -2,12 +2,14 @@ module Ide.Plugin.Cabal.Completion.Completer.Types where +import Data.Text (Text) import Development.IDE as D import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (GenericPackageDescription) import qualified Distribution.Parsec.Position as Syntax import Ide.Plugin.Cabal.Completion.Types import Language.LSP.Protocol.Types (CompletionItem) +import qualified Text.Fuzzy.Parallel as Fuzzy -- | Takes information needed to build possible completion items -- and returns the list of possible completion items @@ -24,5 +26,7 @@ data CompleterData = CompleterData -- | Prefix info to be used for constructing completion items cabalPrefixInfo :: CabalPrefixInfo, -- | The name of the stanza in which the completer is applied - stanzaName :: Maybe StanzaName + stanzaName :: Maybe StanzaName, + -- | The matcher that'll be used to rank the texts against the pattern. + matcher :: Fuzzy.Matcher Text } From 2e284c5f4f460e0cfc3069991bc6ba5971e174f7 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 6 Sep 2025 11:01:40 +0200 Subject: [PATCH 4/7] Add golden test for fixing field typos --- plugins/hls-cabal-plugin/test/Completer.hs | 15 +++++-- plugins/hls-cabal-plugin/test/Main.hs | 45 +++++++++---------- .../code-actions/FieldSuggestionsTypos.cabal | 36 +++++++++++++++ .../FieldSuggestionsTypos.golden.cabal | 36 +++++++++++++++ 4 files changed, 105 insertions(+), 27 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index 1abaacaacf..845d91f2ab 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -28,6 +28,7 @@ import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls +import qualified Text.Fuzzy.Parallel as Fuzzy import Utils completerTests :: TestTree @@ -270,7 +271,7 @@ filePathExposedModulesTests = callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] callFilePathsForExposedModules srcDirs = do let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir - filePathsForExposedModules mempty srcDirs prefInfo + filePathsForExposedModules mempty srcDirs prefInfo $ Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults exposedModuleCompleterTests :: TestTree exposedModuleCompleterTests = @@ -366,11 +367,19 @@ simpleCompleterData sName dir pref = do cabalContents <- ByteString.readFile $ testDataDir "exposed.cabal" pure $ parseGenericPackageDescriptionMaybe cabalContents, getCabalCommonSections = undefined, - stanzaName = sName + stanzaName = sName, + matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults } mkCompleterData :: CabalPrefixInfo -> CompleterData -mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalCommonSections = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} +mkCompleterData prefInfo = + CompleterData + { getLatestGPD = undefined, + getCabalCommonSections = undefined, + cabalPrefixInfo = prefInfo, + stanzaName = Nothing, + matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults + } exposedTestDir :: FilePath exposedTestDir = addTrailingPathSeparator $ testDataDir "src-modules" diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 5570598a37..1a0f890274 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -14,10 +14,9 @@ import Completer (completerTests) import Context (contextTests) import Control.Lens ((^.)) import Control.Lens.Fold ((^?)) -import Control.Monad (guard) +import Control.Monad (forM_, guard) import qualified Data.ByteString as BS import Data.Either (isRight) -import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T @@ -26,6 +25,7 @@ import Definition (gotoDefinitionTests) import Development.IDE.Test import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib +import Language.LSP.Protocol.Lens (HasRange (..)) import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Message as L import Outline (outlineTests) @@ -191,32 +191,29 @@ codeActionTests = testGroup "Code Actions" , " build-depends: base" , " default-language: Haskell2010" ] - , runCabalGoldenSession "Code Actions - Can fix field names" "code-actions" "FieldSuggestions" $ \doc -> do - _ <- waitForDiagnosticsFrom doc - cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc - -- Filter out the code actions we want to invoke. - -- We only want to invoke Code Actions with certain titles, and - -- we want to invoke them only once, not once for each cursor request. - -- 'getAllCodeActions' iterates over each cursor position and requests code actions. - let selectedCas = nubOrdOn (^. L.title) $ filter - (\ca -> (ca ^. L.title) `elem` - [ "Replace with license" - , "Replace with build-type" - , "Replace with extra-doc-files" - , "Replace with ghc-options" - , "Replace with location" - , "Replace with default-language" - , "Replace with import" - , "Replace with build-depends" - , "Replace with main-is" - , "Replace with hs-source-dirs" - ]) cas - mapM_ executeCodeAction selectedCas - pure () + , runCabalGoldenSession + "Code Actions - Can complete field names" + "code-actions" + "FieldSuggestions" + executeFirstActionPerDiagnostic + , runCabalGoldenSession + "Code Actions - Can fix field typos" + "code-actions" + "FieldSuggestionsTypos" + executeFirstActionPerDiagnostic , cabalAddDependencyTests , cabalAddModuleTests ] where + executeFirstActionPerDiagnostic doc = do + _ <- waitForDiagnosticsFrom doc + diagnotics <- getCurrentDiagnostics doc + -- Execute the first code action at each diagnostic point + forM_ diagnotics $ \diagnostic -> do + codeActions <- getCodeActions doc (diagnostic ^. range) + case codeActions of + [] -> pure () + ca : _ -> mapM_ executeCodeAction (ca ^? _R) getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] getLicenseAction license codeActions = do InR action@CodeAction{_title} <- codeActions diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal new file mode 100644 index 0000000000..9fe3067c7c --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal @@ -0,0 +1,36 @@ +cabal-version: 3.0 +name: FieldSuggestions +version: 0.1.0 +liqns: BSD-3-Clause + +quil-type: Simple + +qqxtra-doc-fils: + ChangeLog + +-- Default warnings in HLS +common warnings + ghq-option: -Wall + -Wredundant-constraints + -Wunused-packages + -Wno-name-shadowing + -Wno-unticked-promoted-constructors + +source-repository head + type: git + locqt: fake + +library + qqjfault-lang: Haskell2010 + -- Import isn't supported right now. + iqqor: warnings + bqqld-dep: base + +executable my-exe + mbn-is: Main.hs + +test-suite Test + type: exitcode-stdio-1.0 + main-is: Test.hs + hqqqsource-drs: + diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal new file mode 100644 index 0000000000..99bf84dfd7 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal @@ -0,0 +1,36 @@ +cabal-version: 3.0 +name: FieldSuggestions +version: 0.1.0 +license: BSD-3-Clause + +build-type: Simple + +extra-doc-files: + ChangeLog + +-- Default warnings in HLS +common warnings + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + -Wno-name-shadowing + -Wno-unticked-promoted-constructors + +source-repository head + type: git + location: fake + +library + default-language: Haskell2010 + -- Import isn't supported right now. + import: warnings + build-depends: base + +executable my-exe + main-is: Main.hs + +test-suite Test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: + From 194493f0766f97b335e1f0ce2405232ada00d202 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sat, 6 Sep 2025 12:27:19 +0200 Subject: [PATCH 5/7] Use `edit-distannce` instead of handrolling --- ghcide/ghcide.cabal | 2 +- ghcide/src/Text/Fuzzy/Levenshtein.hs | 30 +++++----------------------- 2 files changed, 6 insertions(+), 26 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 540e902b69..e0433e12d7 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -60,6 +60,7 @@ library , Diff ^>=0.5 || ^>=1.0.0 , directory , dlist + , edit-distance , enummapset , exceptions , extra >=1.7.14 @@ -83,7 +84,6 @@ library , list-t , lsp ^>=2.7 , lsp-types ^>=2.3 - , MemoTrie , mtl , opentelemetry >=0.6.1 , optparse-applicative diff --git a/ghcide/src/Text/Fuzzy/Levenshtein.hs b/ghcide/src/Text/Fuzzy/Levenshtein.hs index df097b9d74..00cd4bca39 100644 --- a/ghcide/src/Text/Fuzzy/Levenshtein.hs +++ b/ghcide/src/Text/Fuzzy/Levenshtein.hs @@ -1,36 +1,16 @@ module Text.Fuzzy.Levenshtein where -import Data.Function (fix) import Data.List (sortOn) -import Data.MemoTrie +import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Array as T -import Data.Text.Internal (Text (..)) +import Text.EditDistance import Text.Fuzzy.Parallel --- | Same caveats apply w.r.t. ASCII as in 'Text.Fuzzy.Parallel'. --- Might be worth optimizing this at some point, but it's good enoughᵗᵐ for now -levenshtein :: Text -> Text -> Int -levenshtein a b | T.null a = T.length b -levenshtein a b | T.null b = T.length a -levenshtein (Text aBuf aOff aLen) (Text bBuf bOff bLen) = do - let aTot = aOff + aLen - bTot = bOff + bLen - go' _ (!aIx, !bIx) | aIx >= aTot || bIx >= bTot = max (aTot - aIx) (bTot - bIx) - go' f (!aIx, !bIx) | T.unsafeIndex aBuf aIx == T.unsafeIndex bBuf bIx = f (aIx + 1, bIx + 1) - go' f (!aIx, !bIx) = - minimum - [ 2 + f (aIx + 1, bIx + 1), -- Give substitutions a heavier cost, so multiple typos cost more - 1 + f (aIx + 1, bIx), - 1 + f (aIx, bIx + 1) - ] - go = fix (memo . go') - go (aOff, bOff) - -- | Sort the given list according to it's levenshtein distance relative to the -- given string. levenshteinScored :: Int -> Text -> [Text] -> [Scored Text] -levenshteinScored chunkSize needle haystack = +levenshteinScored chunkSize needle haystack = do + let levenshtein = levenshteinDistance $ defaultEditCosts {substitutionCosts=ConstantCost 2} sortOn score $ matchPar chunkSize needle haystack id $ - \a b -> Just $ levenshtein a b + \a b -> Just $ levenshtein (T.unpack a) (T.unpack b) From af4faa66a9538abb310634c2913f1abbabfeaf8e Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Thu, 11 Sep 2025 18:56:15 +0200 Subject: [PATCH 6/7] Remove outdated comment from test files --- .../test/testdata/code-actions/FieldSuggestions.cabal | 3 +-- .../test/testdata/code-actions/FieldSuggestions.golden.cabal | 3 +-- .../test/testdata/code-actions/FieldSuggestionsTypos.cabal | 3 +-- .../testdata/code-actions/FieldSuggestionsTypos.golden.cabal | 3 +-- 4 files changed, 4 insertions(+), 8 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal index e32f77b614..0a568e70d2 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal @@ -21,9 +21,8 @@ source-repository head loc: fake library - default-lang: Haskell2010 - -- Import isn't supported right now. impor: warnings + default-lang: Haskell2010 build-dep: base executable my-exe diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal index 99bf84dfd7..e6e2bb3390 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal @@ -21,9 +21,8 @@ source-repository head location: fake library - default-language: Haskell2010 - -- Import isn't supported right now. import: warnings + default-language: Haskell2010 build-depends: base executable my-exe diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal index 9fe3067c7c..21f3b1a837 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.cabal @@ -21,9 +21,8 @@ source-repository head locqt: fake library - qqjfault-lang: Haskell2010 - -- Import isn't supported right now. iqqor: warnings + qqjfault-lang: Haskell2010 bqqld-dep: base executable my-exe diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal index 99bf84dfd7..e6e2bb3390 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestionsTypos.golden.cabal @@ -21,9 +21,8 @@ source-repository head location: fake library - default-language: Haskell2010 - -- Import isn't supported right now. import: warnings + default-language: Haskell2010 build-depends: base executable my-exe From d74eb5cece93f5d51191baac55c007b2a220b531 Mon Sep 17 00:00:00 2001 From: Curtis Chin Jen Sem Date: Sun, 21 Sep 2025 14:09:31 +0200 Subject: [PATCH 7/7] Move `Matcher` type to cabal completion module --- ghcide/src/Text/Fuzzy/Parallel.hs | 4 +--- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 7 +++---- .../src/Ide/Plugin/Cabal/Completion/Completer/Module.hs | 4 ++-- .../src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs | 4 ++-- .../src/Ide/Plugin/Cabal/Completion/Completer/Types.hs | 8 ++++++-- plugins/hls-cabal-plugin/test/Completer.hs | 9 +++++---- 6 files changed, 19 insertions(+), 17 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 3a0ea8e9dd..57eb6a2288 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -4,7 +4,7 @@ module Text.Fuzzy.Parallel ( filter, filter', matchPar, simpleFilter, simpleFilter', match, defChunkSize, defMaxResults, - Scored(..), Matcher (..) + Scored(..) ) where import Control.Parallel.Strategies (evalList, parList, rseq, using) @@ -18,8 +18,6 @@ import Prelude hiding (filter) data Scored a = Scored {score :: !Int, original:: !a} deriving (Functor, Show) -newtype Matcher a = Matcher { runMatcher :: T.Text -> [T.Text] -> [Scored a] } - -- | Returns the rendered output and the -- matching score for a pattern and a text. -- Two examples are given below: diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index c961a914d9..dadc5503fc 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where @@ -237,7 +236,7 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields $ - Fuzzy.Matcher $ + CompleterTypes.Matcher $ Fuzzy.levenshteinScored Fuzzy.defChunkSize let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range @@ -370,7 +369,7 @@ completion recorder ide _ complParams = do let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo res = computeCompletionsAt recorder ide cabalPrefInfo path fields $ - Fuzzy.Matcher $ + CompleterTypes.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults liftIO $ fmap InL res Nothing -> pure . InR $ InR Null @@ -381,7 +380,7 @@ computeCompletionsAt -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] - -> Fuzzy.Matcher T.Text + -> CompleterTypes.Matcher T.Text -> IO [CompletionItem] computeCompletionsAt recorder ide prefInfo fp fields matcher = do runMaybeT (context fields) >>= \case diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs index b63d225a98..6aaa60a0a3 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -48,7 +48,7 @@ filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo - -> Fuzzy.Matcher T.Text + -> Matcher T.Text -> IO [T.Text] filePathsForExposedModules recorder srcDirs prefInfo matcher = do concatForM @@ -59,7 +59,7 @@ filePathsForExposedModules recorder srcDirs prefInfo matcher = do completions <- listFileCompletions recorder pathInfo validExposedCompletions <- filterM (isValidExposedModulePath pathInfo) completions let toMatch = pathSegment pathInfo - scored = Fuzzy.runMatcher + scored = runMatcher matcher toMatch (map T.pack validExposedCompletions) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs index b0a24ecc48..4b0afee35e 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs @@ -41,7 +41,7 @@ errorNoopCompleter l recorder _ = do constantCompleter :: [T.Text] -> Completer constantCompleter completions _ cData = do let prefInfo = cabalPrefixInfo cData - scored = Fuzzy.runMatcher (matcher cData) (completionPrefix prefInfo) completions + scored = runMatcher (matcher cData) (completionPrefix prefInfo) completions range = completionRange prefInfo pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored @@ -68,7 +68,7 @@ importCompleter l cData = do -- it is just forbidden on hackage. nameCompleter :: Completer nameCompleter _ cData = do - let scored = Fuzzy.runMatcher (matcher cData) (completionPrefix prefInfo) [completionFileName prefInfo] + let scored = runMatcher (matcher cData) (completionPrefix prefInfo) [completionFileName prefInfo] prefInfo = cabalPrefixInfo cData range = completionRange prefInfo pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs index 74bfa1ab7e..673e55a1c0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs @@ -3,18 +3,22 @@ module Ide.Plugin.Cabal.Completion.Completer.Types where import Data.Text (Text) +import qualified Data.Text as T import Development.IDE as D import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (GenericPackageDescription) import qualified Distribution.Parsec.Position as Syntax import Ide.Plugin.Cabal.Completion.Types import Language.LSP.Protocol.Types (CompletionItem) -import qualified Text.Fuzzy.Parallel as Fuzzy +import Text.Fuzzy.Parallel -- | Takes information needed to build possible completion items -- and returns the list of possible completion items type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem] +-- | Type signature of completion functions ranking texts against a pattern. +newtype Matcher a = Matcher { runMatcher :: T.Text -> [T.Text] -> [Scored a] } + -- | Contains information to be used by completers. data CompleterData = CompleterData { -- | Access to the latest available generic package description for the handled cabal file, @@ -28,5 +32,5 @@ data CompleterData = CompleterData -- | The name of the stanza in which the completer is applied stanzaName :: Maybe StanzaName, -- | The matcher that'll be used to rank the texts against the pattern. - matcher :: Fuzzy.Matcher Text + matcher :: Matcher Text } diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index 845d91f2ab..f810127f53 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -21,7 +21,8 @@ import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Simple (importCompleter) -import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..)) +import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..), + Matcher (..)) import Ide.Plugin.Cabal.Completion.Completions import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), StanzaName) @@ -271,7 +272,7 @@ filePathExposedModulesTests = callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] callFilePathsForExposedModules srcDirs = do let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir - filePathsForExposedModules mempty srcDirs prefInfo $ Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults + filePathsForExposedModules mempty srcDirs prefInfo $ Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults exposedModuleCompleterTests :: TestTree exposedModuleCompleterTests = @@ -368,7 +369,7 @@ simpleCompleterData sName dir pref = do pure $ parseGenericPackageDescriptionMaybe cabalContents, getCabalCommonSections = undefined, stanzaName = sName, - matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults + matcher = Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults } mkCompleterData :: CabalPrefixInfo -> CompleterData @@ -378,7 +379,7 @@ mkCompleterData prefInfo = getCabalCommonSections = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing, - matcher = Fuzzy.Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults + matcher = Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults } exposedTestDir :: FilePath