Skip to content

Commit 91d2b48

Browse files
crtschincrtschin
authored
Use edit-distance to fix typos in cabal fields (#4722)
* Add levenshtein scoring function * Split off parallel matching from filtering * Allow varying the matcher used in completions * Add golden test for fixing field typos * Use `edit-distannce` instead of handrolling * Remove outdated comment from test files * Move `Matcher` type to cabal completion module
1 parent 808407b commit 91d2b48

File tree

13 files changed

+185
-53
lines changed

13 files changed

+185
-53
lines changed

‎ghcide/ghcide.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,7 @@ library
6060
, Diff ^>=0.5 || ^>=1.0.0
6161
, directory
6262
, dlist
63+
, edit-distance
6364
, enummapset
6465
, exceptions
6566
, extra >=1.7.14
@@ -196,6 +197,7 @@ library
196197
Development.IDE.Types.Shake
197198
Generics.SYB.GHC
198199
Text.Fuzzy.Parallel
200+
Text.Fuzzy.Levenshtein
199201

200202
other-modules:
201203
Development.IDE.Core.FileExists

‎ghcide/src/Text/Fuzzy/Levenshtein.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
module Text.Fuzzy.Levenshtein where
2+
3+
import Data.List (sortOn)
4+
import Data.Text (Text)
5+
import qualified Data.Text as T
6+
import Text.EditDistance
7+
import Text.Fuzzy.Parallel
8+
9+
-- | Sort the given list according to it's levenshtein distance relative to the
10+
-- given string.
11+
levenshteinScored :: Int -> Text -> [Text] -> [Scored Text]
12+
levenshteinScored chunkSize needle haystack = do
13+
let levenshtein = levenshteinDistance $ defaultEditCosts {substitutionCosts=ConstantCost 2}
14+
sortOn score $
15+
matchPar chunkSize needle haystack id $
16+
\a b -> Just $ levenshtein (T.unpack a) (T.unpack b)

‎ghcide/src/Text/Fuzzy/Parallel.hs‎

Lines changed: 20 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
-- | Parallel versions of 'filter' and 'simpleFilter'
22

33
module Text.Fuzzy.Parallel
4-
( filter, filter',
4+
( filter, filter', matchPar,
55
simpleFilter, simpleFilter',
66
match, defChunkSize, defMaxResults,
77
Scored(..)
@@ -103,15 +103,29 @@ filter' :: Int -- ^ Chunk size. 1000 works well.
103103
-- ^ Custom scoring function to use for calculating how close words are
104104
-- When the function returns Nothing, this means the values are incomparable.
105105
-> [Scored t] -- ^ The list of results, sorted, highest score first.
106-
filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore (concat vss)
106+
filter' chunkSize maxRes pat ts extract match' = partialSortByAscScore maxRes perfectScore $
107+
matchPar chunkSize pat' ts extract match'
107108
where
108-
-- Preserve case for the first character, make all others lowercase
109-
pat' = case T.uncons pat of
109+
perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat pat
110+
-- Preserve case for the first character, make all others lowercase
111+
pat' = case T.uncons pat of
110112
Just (c, rest) -> T.cons c (T.toLower rest)
111113
_ -> pat
112-
vss = map (mapMaybe (\t -> flip Scored t <$> match' pat' (extract t))) (chunkList chunkSize ts)
114+
115+
matchPar
116+
:: Int -- ^ Chunk size. 1000 works well.
117+
-> T.Text -- ^ Pattern.
118+
-> [t] -- ^ The list of values containing the text to search in.
119+
-> (t -> T.Text) -- ^ The function to extract the text from the container.
120+
-> (T.Text -> T.Text -> Maybe Int)
121+
-- ^ Custom scoring function to use for calculating how close words are
122+
-- When the function returns Nothing, this means the values are incomparable.
123+
-> [Scored t] -- ^ The list of results, sorted, highest score first.
124+
{-# INLINABLE matchPar #-}
125+
matchPar chunkSize pat ts extract match' = concat vss
126+
where
127+
vss = map (mapMaybe (\t -> flip Scored t <$> match' pat (extract t))) (chunkList chunkSize ts)
113128
`using` parList (evalList rseq)
114-
perfectScore = fromMaybe (error $ T.unpack pat) $ match' pat' pat'
115129

116130
-- | The function to filter a list of values by fuzzy search on the text extracted from them,
117131
-- using a custom matching function which determines how close words are.

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs‎

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@
22
{-# LANGUAGE DuplicateRecordFields #-}
33
{-# LANGUAGE LambdaCase #-}
44
{-# LANGUAGE OverloadedStrings #-}
5-
{-# LANGUAGE PatternSynonyms #-}
65
{-# LANGUAGE TypeFamilies #-}
76

87
module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
@@ -55,6 +54,8 @@ import qualified Language.LSP.Protocol.Lens as JL
5554
import qualified Language.LSP.Protocol.Message as LSP
5655
import Language.LSP.Protocol.Types
5756
import qualified Language.LSP.VFS as VFS
57+
import qualified Text.Fuzzy.Levenshtein as Fuzzy
58+
import qualified Text.Fuzzy.Parallel as Fuzzy
5859
import Text.Regex.TDFA
5960

6061
data Log
@@ -234,7 +235,9 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
234235
fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName))
235236
lspPrefixInfo = Ghcide.getCompletionPrefixFromRope fakeLspCursorPosition fileContents
236237
cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
237-
completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields
238+
completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields $
239+
CompleterTypes.Matcher $
240+
Fuzzy.levenshteinScored Fuzzy.defChunkSize
238241
let completionTexts = fmap (^. JL.label) completions
239242
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
240243

@@ -365,12 +368,21 @@ completion recorder ide _ complParams = do
365368
Just (fields, _) -> do
366369
let lspPrefInfo = Ghcide.getCompletionPrefixFromRope position cnts
367370
cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo
368-
let res = computeCompletionsAt recorder ide cabalPrefInfo path fields
371+
res = computeCompletionsAt recorder ide cabalPrefInfo path fields $
372+
CompleterTypes.Matcher $
373+
Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
369374
liftIO $ fmap InL res
370375
Nothing -> pure . InR $ InR Null
371376

372-
computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
373-
computeCompletionsAt recorder ide prefInfo fp fields = do
377+
computeCompletionsAt
378+
:: Recorder (WithPriority Log)
379+
-> IdeState
380+
-> Types.CabalPrefixInfo
381+
-> FilePath
382+
-> [Syntax.Field Syntax.Position]
383+
-> CompleterTypes.Matcher T.Text
384+
-> IO [CompletionItem]
385+
computeCompletionsAt recorder ide prefInfo fp fields matcher = do
374386
runMaybeT (context fields) >>= \case
375387
Nothing -> pure []
376388
Just ctx -> do
@@ -390,6 +402,7 @@ computeCompletionsAt recorder ide prefInfo fp fields = do
390402
case fst ctx of
391403
Types.Stanza _ name -> name
392404
_ -> Nothing
405+
, matcher = matcher
393406
}
394407
completions <- completer completerRecorder completerData
395408
pure completions

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,7 @@ modulesCompleter extractionFunction recorder cData = do
3333
case mGPD of
3434
Just gpd -> do
3535
let sourceDirs = extractionFunction sName gpd
36-
filePathCompletions <-
37-
filePathsForExposedModules recorder sourceDirs prefInfo
36+
filePathCompletions <- filePathsForExposedModules recorder sourceDirs prefInfo (matcher cData)
3837
pure $ map (\compl -> mkSimpleCompletionItem (completionRange prefInfo) compl) filePathCompletions
3938
Nothing -> do
4039
logWith recorder Debug LogUseWithStaleFastNoResult
@@ -45,8 +44,13 @@ modulesCompleter extractionFunction recorder cData = do
4544

4645
-- | Takes a list of source directories and returns a list of path completions
4746
-- relative to any of the passed source directories which fit the passed prefix info.
48-
filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [T.Text]
49-
filePathsForExposedModules recorder srcDirs prefInfo = do
47+
filePathsForExposedModules
48+
:: Recorder (WithPriority Log)
49+
-> [FilePath]
50+
-> CabalPrefixInfo
51+
-> Matcher T.Text
52+
-> IO [T.Text]
53+
filePathsForExposedModules recorder srcDirs prefInfo matcher = do
5054
concatForM
5155
srcDirs
5256
( \dir' -> do
@@ -55,9 +59,8 @@ filePathsForExposedModules recorder srcDirs prefInfo = do
5559
completions <- listFileCompletions recorder pathInfo
5660
validExposedCompletions <- filterM (isValidExposedModulePath pathInfo) completions
5761
let toMatch = pathSegment pathInfo
58-
scored = Fuzzy.simpleFilter
59-
Fuzzy.defChunkSize
60-
Fuzzy.defMaxResults
62+
scored = runMatcher
63+
matcher
6164
toMatch
6265
(map T.pack validExposedCompletions)
6366
forM

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ errorNoopCompleter l recorder _ = do
4141
constantCompleter :: [T.Text] -> Completer
4242
constantCompleter completions _ cData = do
4343
let prefInfo = cabalPrefixInfo cData
44-
scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) completions
44+
scored = runMatcher (matcher cData) (completionPrefix prefInfo) completions
4545
range = completionRange prefInfo
4646
pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored
4747

@@ -68,7 +68,7 @@ importCompleter l cData = do
6868
-- it is just forbidden on hackage.
6969
nameCompleter :: Completer
7070
nameCompleter _ cData = do
71-
let scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) [completionFileName prefInfo]
71+
let scored = runMatcher (matcher cData) (completionPrefix prefInfo) [completionFileName prefInfo]
7272
prefInfo = cabalPrefixInfo cData
7373
range = completionRange prefInfo
7474
pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored
@@ -85,6 +85,7 @@ weightedConstantCompleter completions weights _ cData = do
8585
let scored =
8686
if perfectScore > 0
8787
then
88+
-- TODO: Would be nice to use to be able to use the matcher in `cData`
8889
fmap Fuzzy.original $
8990
Fuzzy.simpleFilter' Fuzzy.defChunkSize Fuzzy.defMaxResults prefix completions customMatch
9091
else topTenByWeight

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,23 @@
22

33
module Ide.Plugin.Cabal.Completion.Completer.Types where
44

5+
import Data.Text (Text)
6+
import qualified Data.Text as T
57
import Development.IDE as D
68
import qualified Distribution.Fields as Syntax
79
import Distribution.PackageDescription (GenericPackageDescription)
810
import qualified Distribution.Parsec.Position as Syntax
911
import Ide.Plugin.Cabal.Completion.Types
1012
import Language.LSP.Protocol.Types (CompletionItem)
13+
import Text.Fuzzy.Parallel
1114

1215
-- | Takes information needed to build possible completion items
1316
-- and returns the list of possible completion items
1417
type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem]
1518

19+
-- | Type signature of completion functions ranking texts against a pattern.
20+
newtype Matcher a = Matcher { runMatcher :: T.Text -> [T.Text] -> [Scored a] }
21+
1622
-- | Contains information to be used by completers.
1723
data CompleterData = CompleterData
1824
{ -- | Access to the latest available generic package description for the handled cabal file,
@@ -24,5 +30,7 @@ data CompleterData = CompleterData
2430
-- | Prefix info to be used for constructing completion items
2531
cabalPrefixInfo :: CabalPrefixInfo,
2632
-- | The name of the stanza in which the completer is applied
27-
stanzaName :: Maybe StanzaName
33+
stanzaName :: Maybe StanzaName,
34+
-- | The matcher that'll be used to rank the texts against the pattern.
35+
matcher :: Matcher Text
2836
}

‎plugins/hls-cabal-plugin/test/Completer.hs‎

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,13 +21,15 @@ import Ide.Plugin.Cabal.Completion.Completer.FilePath
2121
import Ide.Plugin.Cabal.Completion.Completer.Module
2222
import Ide.Plugin.Cabal.Completion.Completer.Paths
2323
import Ide.Plugin.Cabal.Completion.Completer.Simple (importCompleter)
24-
import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..))
24+
import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..),
25+
Matcher (..))
2526
import Ide.Plugin.Cabal.Completion.Completions
2627
import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..),
2728
StanzaName)
2829
import qualified Language.LSP.Protocol.Lens as L
2930
import System.FilePath
3031
import Test.Hls
32+
import qualified Text.Fuzzy.Parallel as Fuzzy
3133
import Utils
3234

3335
completerTests :: TestTree
@@ -270,7 +272,7 @@ filePathExposedModulesTests =
270272
callFilePathsForExposedModules :: [FilePath] -> IO [T.Text]
271273
callFilePathsForExposedModules srcDirs = do
272274
let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir
273-
filePathsForExposedModules mempty srcDirs prefInfo
275+
filePathsForExposedModules mempty srcDirs prefInfo $ Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
274276

275277
exposedModuleCompleterTests :: TestTree
276278
exposedModuleCompleterTests =
@@ -366,11 +368,19 @@ simpleCompleterData sName dir pref = do
366368
cabalContents <- ByteString.readFile $ testDataDir </> "exposed.cabal"
367369
pure $ parseGenericPackageDescriptionMaybe cabalContents,
368370
getCabalCommonSections = undefined,
369-
stanzaName = sName
371+
stanzaName = sName,
372+
matcher = Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
370373
}
371374

372375
mkCompleterData :: CabalPrefixInfo -> CompleterData
373-
mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalCommonSections = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
376+
mkCompleterData prefInfo =
377+
CompleterData
378+
{ getLatestGPD = undefined,
379+
getCabalCommonSections = undefined,
380+
cabalPrefixInfo = prefInfo,
381+
stanzaName = Nothing,
382+
matcher = Matcher $ Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults
383+
}
374384

375385
exposedTestDir :: FilePath
376386
exposedTestDir = addTrailingPathSeparator $ testDataDir </> "src-modules"

‎plugins/hls-cabal-plugin/test/Main.hs‎

Lines changed: 21 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -14,10 +14,9 @@ import Completer (completerTests)
1414
import Context (contextTests)
1515
import Control.Lens ((^.))
1616
import Control.Lens.Fold ((^?))
17-
import Control.Monad (guard)
17+
import Control.Monad (forM_, guard)
1818
import qualified Data.ByteString as BS
1919
import Data.Either (isRight)
20-
import Data.List.Extra (nubOrdOn)
2120
import qualified Data.Maybe as Maybe
2221
import Data.Text (Text)
2322
import qualified Data.Text as T
@@ -26,6 +25,7 @@ import Definition (gotoDefinitionTests)
2625
import Development.IDE.Test
2726
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
2827
import qualified Ide.Plugin.Cabal.Parse as Lib
28+
import Language.LSP.Protocol.Lens (HasRange (..))
2929
import qualified Language.LSP.Protocol.Lens as L
3030
import qualified Language.LSP.Protocol.Message as L
3131
import Outline (outlineTests)
@@ -191,32 +191,29 @@ codeActionTests = testGroup "Code Actions"
191191
, " build-depends: base"
192192
, " default-language: Haskell2010"
193193
]
194-
, runCabalGoldenSession "Code Actions - Can fix field names" "code-actions" "FieldSuggestions" $ \doc -> do
195-
_ <- waitForDiagnosticsFrom doc
196-
cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc
197-
-- Filter out the code actions we want to invoke.
198-
-- We only want to invoke Code Actions with certain titles, and
199-
-- we want to invoke them only once, not once for each cursor request.
200-
-- 'getAllCodeActions' iterates over each cursor position and requests code actions.
201-
let selectedCas = nubOrdOn (^. L.title) $ filter
202-
(\ca -> (ca ^. L.title) `elem`
203-
[ "Replace with license"
204-
, "Replace with build-type"
205-
, "Replace with extra-doc-files"
206-
, "Replace with ghc-options"
207-
, "Replace with location"
208-
, "Replace with default-language"
209-
, "Replace with import"
210-
, "Replace with build-depends"
211-
, "Replace with main-is"
212-
, "Replace with hs-source-dirs"
213-
]) cas
214-
mapM_ executeCodeAction selectedCas
215-
pure ()
194+
, runCabalGoldenSession
195+
"Code Actions - Can complete field names"
196+
"code-actions"
197+
"FieldSuggestions"
198+
executeFirstActionPerDiagnostic
199+
, runCabalGoldenSession
200+
"Code Actions - Can fix field typos"
201+
"code-actions"
202+
"FieldSuggestionsTypos"
203+
executeFirstActionPerDiagnostic
216204
, cabalAddDependencyTests
217205
, cabalAddModuleTests
218206
]
219207
where
208+
executeFirstActionPerDiagnostic doc = do
209+
_ <- waitForDiagnosticsFrom doc
210+
diagnotics <- getCurrentDiagnostics doc
211+
-- Execute the first code action at each diagnostic point
212+
forM_ diagnotics $ \diagnostic -> do
213+
codeActions <- getCodeActions doc (diagnostic ^. range)
214+
case codeActions of
215+
[] -> pure ()
216+
ca : _ -> mapM_ executeCodeAction (ca ^? _R)
220217
getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction]
221218
getLicenseAction license codeActions = do
222219
InR action@CodeAction{_title} <- codeActions

‎plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,8 @@ source-repository head
2121
loc: fake
2222

2323
library
24-
default-lang: Haskell2010
25-
-- Import isn't supported right now.
2624
impor: warnings
25+
default-lang: Haskell2010
2726
build-dep: base
2827

2928
executable my-exe

0 commit comments

Comments
 (0)