diff --git a/ghcide.cabal b/ghcide.cabal --- a/ghcide.cabal +++ b/ghcide.cabal @@ -2,7 +2,7 @@ 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/src/Development/IDE/Plugin/Completions/Logic.hs b/src/Development/IDE/Plugin/Completions/Logic.hs --- a/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/src/Development/IDE/Plugin/Completions/Logic.hs @@ -557,9 +557,9 @@ 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 @@ -606,7 +606,7 @@ filtListWith f list = [ f label - | label <- Fuzzy.simpleFilter chunkSize fullPrefix list + | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix list , enteredQual `T.isPrefixOf` label ] @@ -634,8 +634,7 @@ -> 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/src/Text/Fuzzy/Parallel.hs b/src/Text/Fuzzy/Parallel.hs --- a/src/Text/Fuzzy/Parallel.hs +++ b/src/Text/Fuzzy/Parallel.hs @@ -10,23 +10,19 @@ 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 @@ -> (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 @@ {-# 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 @@ -- [[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 [] = [] 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/test/exe/Main.hs b/test/exe/Main.hs --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -4470,7 +4470,9 @@ 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", @@ -4486,9 +4488,8 @@ ] liftIO $ take 3 (sort compls') @?= map ("Defined in "<>) - [ "'Data.IntMap" - , "'Data.IntMap.Lazy" - , "'Data.IntMap.Strict" + [ "'Data.List.NonEmpty" + , "'GHC.Exts" ] , testSessionWait "Map" $ do