Include fuzzy scores in completions sort text

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
 
 ----------------------------------------------------------------------------------------------------
 

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'

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