From 90f43a57d2eb7ef7e34617b79163ee3ba1995a11 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 6 Nov 2021 22:36:53 +0000 Subject: [PATCH] Include fuzzy scores in completions sort text --- .../src/Development/IDE/Plugin/Completions.hs | 34 +++++++-- .../IDE/Plugin/Completions/Logic.hs | 73 ++++++++++++++++--- ghcide/src/Text/Fuzzy/Parallel.hs | 19 +++-- 3 files changed, 101 insertions(+), 25 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 3b22d063a7..fd5773a3bd 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -47,6 +47,8 @@ import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.VFS as VFS +import Text.Fuzzy.Parallel (Scored (..)) + descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) @@ -174,7 +176,7 @@ getCompletionsLSP ide plId of repeated occurrences we generate sortText values that include both the label and an index denoting the relative order - EXAMPLE + EXAMPLE OF DESIRED BEHAVIOUR We produce completions: x -- local y -- local @@ -188,15 +190,33 @@ getCompletionsLSP ide plId x -- global This is fine if the LSP client thinks that 'y' is more relevant than 'x'. - We are OK with that choice since the local options are presented before the global ones + Importantly, the local options are presented before the global ones + We provide the LSP client with 3 sorting measures encoded in _sortText: + 1. The distance to the best fuzzy score + 2. The label + 3. The index in our original sorted list -} -orderedCompletions :: [CompletionItem] -> [CompletionItem] -orderedCompletions = zipWith addOrder [0..] + +orderedCompletions :: [Scored CompletionItem] -> [CompletionItem] +orderedCompletions [] = [] +orderedCompletions xx@(h:_) = zipWith addOrder [0..] xx where - addOrder :: Int -> CompletionItem -> CompletionItem - addOrder n it@CompletionItem{_label} = - it{_sortText = Just $ _label <> T.pack(show n)} + lxx = digits $ Prelude.length xx + lm = digits maxScore + maxScore = score_ h + + digits = Prelude.length . show + + addOrder :: Int -> Scored CompletionItem -> CompletionItem + addOrder n Scored{score_, original = it@CompletionItem{_label,_sortText}} = + it{_sortText = Just $ + (T.pack(pad lm (maxScore - score_))) <> + _label <> + T.pack(pad lxx n) + } + + pad n x = let sx = show x in replicate (n - Prelude.length sx) '0' <> sx ---------------------------------------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index a345e24889..a7d0b7d780 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -29,6 +29,7 @@ import qualified Text.Fuzzy.Parallel as Fuzzy import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Either (fromRight) +import Data.Function (on) import Data.Functor import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet @@ -52,6 +53,8 @@ import Ide.Types (CommandId (..), import Language.LSP.Types import Language.LSP.Types.Capabilities import qualified Language.LSP.VFS as VFS +import Text.Fuzzy.Parallel (Scored (score_), + original) -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int @@ -200,6 +203,7 @@ mkCompl MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs' + mkAdditionalEditsCommand :: PluginId -> ExtendImport -> Command mkAdditionalEditsCommand pId edits = mkLspCommand pId (CommandId extendImportCommandId) "extend import" (Just [toJSON edits]) @@ -525,7 +529,7 @@ getCompletions -> ClientCapabilities -> CompletionsConfig -> HM.HashMap T.Text (HashSet.HashSet IdentInfo) - -> IO [CompletionItem] + -> IO [Scored CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo @@ -541,12 +545,14 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu maxC = maxCompletions config + filtModNameCompls :: [Scored CompletionItem] filtModNameCompls = - map mkModCompl - $ mapMaybe (T.stripPrefix enteredQual) - $ Fuzzy.simpleFilter chunkSize maxC fullPrefix allModNamesAsNS + (fmap.fmap) mkModCompl + $ Fuzzy.simpleFilter chunkSize maxC fullPrefix + $ (if T.null enteredQual then id else mapMaybe (T.stripPrefix enteredQual)) + $ allModNamesAsNS - filtCompls = map Fuzzy.original $ Fuzzy.filter chunkSize maxC prefixText ctxCompls "" "" label False + filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls "" "" label False where mcc = case maybe_parsed of @@ -592,9 +598,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu ++ (($ Just prefixModule) <$> anyQualCompls) filtListWith f list = - [ f label + [ fmap f label | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix list - , enteredQual `T.isPrefixOf` label + , enteredQual `T.isPrefixOf` original label ] filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules @@ -621,11 +627,13 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu -> return [] | otherwise -> do -- assumes that nubOrdBy is stable - let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls - let compls = map (mkCompl plId ideOpts) uniqueFiltCompls - return $ filtModNameCompls - ++ filtKeywordCompls - ++ map (toggleSnippets caps config) compls + let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` Fuzzy.original) filtCompls + let compls = (fmap.fmap) (mkCompl plId ideOpts) uniqueFiltCompls + return $ mergeListsBy (flip compare `on` score_) + [ filtModNameCompls + , filtKeywordCompls + , (fmap.fmap) (toggleSnippets caps config) compls + ] uniqueCompl :: CompItem -> CompItem -> Ordering uniqueCompl x y = @@ -777,3 +785,44 @@ getImportQual :: LImportDecl GhcPs -> Maybe T.Text getImportQual (L _ imp) | isQualifiedImport imp = Just $ T.pack $ moduleNameString $ maybe (unLoc $ ideclName imp) unLoc (ideclAs imp) | otherwise = Nothing + +-------------------------------------------------------------------------------- + +-- This comes from the GHC.Utils.Misc module (not exported) +-- | Merge an unsorted list of sorted lists, for example: +-- +-- > mergeListsBy compare [ [2,5,15], [1,10,100] ] = [1,2,5,10,15,100] +-- +-- \( O(n \log{} k) \) +mergeListsBy :: forall a. (a -> a -> Ordering) -> [[a]] -> [a] +mergeListsBy cmp all_lists = merge_lists all_lists + where + -- Implements "Iterative 2-Way merge" described at + -- https://en.wikipedia.org/wiki/K-way_merge_algorithm + + -- Merge two sorted lists into one in O(n). + merge2 :: [a] -> [a] -> [a] + merge2 [] ys = ys + merge2 xs [] = xs + merge2 (x:xs) (y:ys) = + case cmp x y of + Prelude.GT -> y : merge2 (x:xs) ys + _ -> x : merge2 xs (y:ys) + + -- Merge the first list with the second, the third with the fourth, and so + -- on. The output has half as much lists as the input. + merge_neighbours :: [[a]] -> [[a]] + merge_neighbours [] = [] + merge_neighbours [xs] = [xs] + merge_neighbours (xs : ys : lists) = + merge2 xs ys : merge_neighbours lists + + -- Since 'merge_neighbours' halves the amount of lists in each iteration, + -- we perform O(log k) iteration. Each iteration is O(n). The total running + -- time is therefore O(n log k). + merge_lists :: [[a]] -> [a] + merge_lists lists = + case merge_neighbours lists of + [] -> [] + [xs] -> xs + lists' -> merge_lists lists' diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 700cad4596..221318ba5d 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -2,8 +2,9 @@ module Text.Fuzzy.Parallel ( filter, simpleFilter, + Scored(..), -- reexports - Fuzzy(..), + Fuzzy, match ) where @@ -19,6 +20,9 @@ import Data.Maybe (fromJust) import Prelude hiding (filter) import Text.Fuzzy (Fuzzy (..), match) +data Scored a = Scored {score_ :: !Int, original:: !a} + deriving Functor + -- | The function to filter a list of values by fuzzy search on the text extracted from them. filter :: (TextualMonoid s) => Int -- ^ Chunk size. 1000 works well. @@ -29,7 +33,7 @@ filter :: (TextualMonoid s) -> s -- ^ The text to add after each match. -> (t -> s) -- ^ The function to extract the text from the container. -> Bool -- ^ Case sensitivity. - -> [Fuzzy t s] -- ^ The list of results, sorted, highest score first. + -> [Scored t] -- ^ The list of results, sorted, highest score first. filter chunkSize maxRes pattern ts pre post extract caseSen = runST $ do let v = V.mapMaybe id (V.map (\t -> match pattern t pre post extract caseSen) (V.fromList ts) @@ -50,9 +54,9 @@ simpleFilter :: (TextualMonoid s) -> Int -- ^ Max. number of results wanted -> s -- ^ Pattern to look for. -> [s] -- ^ List of texts to check. - -> [s] -- ^ The ones that match. + -> [Scored s] -- ^ The ones that match. simpleFilter chunk maxRes pattern xs = - map original $ filter chunk maxRes pattern xs mempty mempty id False + filter chunk maxRes pattern xs mempty mempty id False -------------------------------------------------------------------------------- @@ -102,7 +106,7 @@ partialSortByAscScore :: TextualMonoid s => Int -- ^ Number of items needed -> Int -- ^ Value of a perfect score -> Vector (Fuzzy t s) - -> [Fuzzy t s] + -> [Scored t] partialSortByAscScore wantedCount perfectScore v = loop 0 (SortState minBound perfectScore 0) [] where l = V.length v loop index st@SortState{..} acc @@ -115,12 +119,15 @@ partialSortByAscScore wantedCount perfectScore v = loop 0 (SortState minBound pe | otherwise = case v!index of x | score x == scoreWanted - -> loop (index+1) st{foundCount = foundCount+1} (x:acc) + -> loop (index+1) st{foundCount = foundCount+1} (toScored x:acc) | score x < scoreWanted && score x > bestScoreSeen -> loop (index+1) st{bestScoreSeen = score x} acc | otherwise -> loop (index+1) st acc +toScored :: TextualMonoid s => Fuzzy t s -> Scored t +toScored Fuzzy{..} = Scored score original + data SortState a = SortState { bestScoreSeen :: !Int , scoreWanted :: !Int