diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 71677245af..72e304ddec 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -2,7 +2,7 @@ cabal-version: 2.4 build-type: Simple category: Development name: ghcide -version: 1.4.2.2 +version: 1.4.2.3 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index eff74b5de3..a345e24889 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -544,9 +544,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu filtModNameCompls = map mkModCompl $ mapMaybe (T.stripPrefix enteredQual) - $ Fuzzy.simpleFilter chunkSize fullPrefix allModNamesAsNS + $ Fuzzy.simpleFilter chunkSize maxC fullPrefix allModNamesAsNS - filtCompls = map Fuzzy.original $ Fuzzy.filter chunkSize prefixText ctxCompls "" "" label False + filtCompls = map Fuzzy.original $ Fuzzy.filter chunkSize maxC prefixText ctxCompls "" "" label False where mcc = case maybe_parsed of @@ -593,7 +593,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu filtListWith f list = [ f label - | label <- Fuzzy.simpleFilter chunkSize fullPrefix list + | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix list , enteredQual `T.isPrefixOf` label ] @@ -621,8 +621,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu -> return [] | otherwise -> do -- assumes that nubOrdBy is stable - -- nubOrd is very slow - take 10x the maximum configured - let uniqueFiltCompls = nubOrdBy uniqueCompl $ take (maxC*10) filtCompls + let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls let compls = map (mkCompl plId ideOpts) uniqueFiltCompls return $ filtModNameCompls ++ filtKeywordCompls diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 7af9b40547..700cad4596 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -10,23 +10,19 @@ module Text.Fuzzy.Parallel import Control.Monad.ST (runST) import Control.Parallel.Strategies (Eval, Strategy, evalTraversable, parTraversable, rseq, using) -import Data.Function (on) import Data.Monoid.Textual (TextualMonoid) -import Data.Ord (Down (Down)) import Data.Vector (Vector, (!)) import qualified Data.Vector as V -- need to use a stable sort import Data.Bifunctor (second) -import qualified Data.Vector.Algorithms.Tim as VA +import Data.Maybe (fromJust) import Prelude hiding (filter) import Text.Fuzzy (Fuzzy (..), match) -- | The function to filter a list of values by fuzzy search on the text extracted from them. --- --- >>> length $ filter 1000 200 "ML" (concat $ replicate 10000 [("Standard ML", 1990),("OCaml",1996),("Scala",2003)]) "<" ">" fst False --- 200 filter :: (TextualMonoid s) => Int -- ^ Chunk size. 1000 works well. + -> Int -- ^ Max. number of results wanted -> s -- ^ Pattern. -> [t] -- ^ The list of values containing the text to search in. -> s -- ^ The text to add before each match. @@ -34,15 +30,13 @@ filter :: (TextualMonoid s) -> (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. -filter chunkSize pattern ts pre post extract caseSen = runST $ do - let v = (V.mapMaybe id +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) `using` - parVectorChunk chunkSize (evalTraversable forceScore))) - v' <- V.unsafeThaw v - VA.sortBy (compare `on` (Down . score)) v' - v'' <- V.unsafeFreeze v' - return $ V.toList v'' + parVectorChunk chunkSize (evalTraversable forceScore)) + perfectScore = score $ fromJust $ match pattern pattern "" "" id False + return $ partialSortByAscScore maxRes perfectScore v -- | Return all elements of the list that have a fuzzy -- match against the pattern. Runs with default settings where @@ -53,11 +47,12 @@ filter chunkSize pattern ts pre post extract caseSen = runST $ do {-# INLINABLE simpleFilter #-} simpleFilter :: (TextualMonoid s) => Int -- ^ Chunk size. 1000 works well. + -> Int -- ^ Max. number of results wanted -> s -- ^ Pattern to look for. -> [s] -- ^ List of texts to check. -> [s] -- ^ The ones that match. -simpleFilter chunk pattern xs = - map original $ filter chunk pattern xs mempty mempty id False +simpleFilter chunk maxRes pattern xs = + map original $ filter chunk maxRes pattern xs mempty mempty id False -------------------------------------------------------------------------------- @@ -82,10 +77,8 @@ parVectorChunk chunkSize st v = -- [[0,1,2],[3,4,5],[6,7,8],[9,10,11],[12]] chunkVector :: Int -> Vector a -> [Vector a] chunkVector chunkSize v = do - let indices = chunkIndices chunkSize (0,l) - l = V.length v - [V.fromListN (h-l+1) [v ! j | j <- [l .. h]] - | (l,h) <- indices] + let indices = chunkIndices chunkSize (0,V.length v) + [V.slice l (h-l) v | (l,h) <- indices] -- >>> chunkIndices 3 (0,9) -- >>> chunkIndices 3 (0,10) @@ -103,3 +96,34 @@ pairwise :: [a] -> [(a,a)] pairwise [] = [] pairwise [_] = [] pairwise (x:y:xs) = (x,y) : pairwise (y:xs) + +-- | A stable partial sort ascending by score. O(N) best case, O(wanted*N) worst case +partialSortByAscScore :: TextualMonoid s + => Int -- ^ Number of items needed + -> Int -- ^ Value of a perfect score + -> Vector (Fuzzy t s) + -> [Fuzzy t s] +partialSortByAscScore wantedCount perfectScore v = loop 0 (SortState minBound perfectScore 0) [] where + l = V.length v + loop index st@SortState{..} acc + | foundCount == wantedCount = reverse acc + | index == l +-- ProgressCancelledException + = if bestScoreSeen < scoreWanted + then loop 0 st{scoreWanted = bestScoreSeen, bestScoreSeen = minBound} acc + else reverse acc + | otherwise = + case v!index of + x | score x == scoreWanted + -> loop (index+1) st{foundCount = foundCount+1} (x:acc) + | score x < scoreWanted && score x > bestScoreSeen + -> loop (index+1) st{bestScoreSeen = score x} acc + | otherwise + -> loop (index+1) st acc + +data SortState a = SortState + { bestScoreSeen :: !Int + , scoreWanted :: !Int + , foundCount :: !Int + } + deriving Show diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 0f7e78fa28..cebecff33e 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4508,7 +4508,9 @@ otherCompletionTests = [ packageCompletionTests :: [TestTree] packageCompletionTests = - [ testSessionWait "fromList" $ do + [ testSession' "fromList" $ \dir -> do + liftIO $ writeFile (dir "hie.yaml") + "cradle: {direct: {arguments: [-hide-all-packages, -package, base, A]}}" doc <- createDoc "A.hs" "haskell" $ T.unlines [ "{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", @@ -4524,9 +4526,8 @@ packageCompletionTests = ] liftIO $ take 3 (sort compls') @?= map ("Defined in "<>) - [ "'Data.IntMap" - , "'Data.IntMap.Lazy" - , "'Data.IntMap.Strict" + [ "'Data.List.NonEmpty" + , "'GHC.Exts" ] , testSessionWait "Map" $ do