From 94ccf023fb5d928018dc4b5e262e6a6d4bd9c020 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Sep 2021 08:47:56 +0200 Subject: [PATCH 1/7] partial sort of fuzzy filtering results --- .../IDE/Plugin/Completions/Logic.hs | 9 ++-- ghcide/src/Text/Fuzzy/Parallel.hs | 49 +++++++++++++++---- 2 files changed, 43 insertions(+), 15 deletions(-) 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..61d71c38ae 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -10,14 +10,12 @@ 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 qualified Data.Monoid.Factorial as T import Prelude hiding (filter) import Text.Fuzzy (Fuzzy (..), match) @@ -27,6 +25,7 @@ import Text.Fuzzy (Fuzzy (..), match) -- 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 +33,12 @@ 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 +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'' + return $ partialSortByAscScore maxRes (T.length pattern) v -- | Return all elements of the list that have a fuzzy -- match against the pattern. Runs with default settings where @@ -53,11 +49,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 -------------------------------------------------------------------------------- @@ -103,3 +100,35 @@ 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 3 5 $ V.fromList $ map (\x -> Fuzzy x x (length x)) ["A","B","ABCDE","ABBC"] +-- [Fuzzy {original = "ABCDE", rendered = "ABCDE", score = 5},Fuzzy {original = "ABBC", rendered = "ABBC", score = 4},Fuzzy {original = "A", rendered = "A", score = 1}] +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 + = 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 From 12525fa3a7fb40010bed969b2309c0e4e753595d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Sep 2021 10:53:30 +0200 Subject: [PATCH 2/7] use slice instead of fromWithN for another 2% --- ghcide/src/Text/Fuzzy/Parallel.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 61d71c38ae..5fa3b793af 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -79,10 +79,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+1) v | (l,h) <- indices] -- >>> chunkIndices 3 (0,9) -- >>> chunkIndices 3 (0,10) @@ -114,6 +112,7 @@ partialSortByAscScore wantedCount perfectScore v = loop 0 (SortState minBound pe 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 From eefe2f50913bfad93c98370b6f74f04675ea7927 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 24 Sep 2021 16:09:46 +0200 Subject: [PATCH 3/7] fix perfect score computation --- ghcide/src/Text/Fuzzy/Parallel.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 5fa3b793af..7a48bb3db0 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -15,12 +15,22 @@ import Data.Vector (Vector, (!)) import qualified Data.Vector as V -- need to use a stable sort import Data.Bifunctor (second) +import Data.Maybe (fromJust) import qualified Data.Monoid.Factorial as T 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. -- +-- >>> map (\x -> score <$> match ("lookup"::String) x "" "" id False) ["splitLookup"::String, "lookupInput"] +-- WAS WAS WAS WAS NOW [Just 58,Just 120] +-- WAS WAS WAS NOW [Just 58,Just 120] +-- WAS WAS NOW [Just 58,Just 120] +-- WAS NOW [Just 58,Just 120] +-- NOW [Just 58,Just 120] +-- >>> take 10 $ iterate (\(tot, cur) -> let cur' = 2*cur + 1 in (tot + cur', cur')) (0,0) +-- NOW [(0,0),(1,1),(4,3),(11,7),(26,15),(57,31),(120,63),(247,127),(502,255),(1013,511)] + -- >>> length $ filter 1000 200 "ML" (concat $ replicate 10000 [("Standard ML", 1990),("OCaml",1996),("Scala",2003)]) "<" ">" fst False -- 200 filter :: (TextualMonoid s) @@ -34,11 +44,12 @@ filter :: (TextualMonoid s) -> Bool -- ^ Case sensitivity. -> [Fuzzy t s] -- ^ The list of results, sorted, highest score first. filter chunkSize maxRes pattern ts pre post extract caseSen = runST $ do - let v = (V.mapMaybe id + let v = V.mapMaybe id (V.map (\t -> match pattern t pre post extract caseSen) (V.fromList ts) `using` - parVectorChunk chunkSize (evalTraversable forceScore))) - return $ partialSortByAscScore maxRes (T.length pattern) 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 @@ -80,7 +91,7 @@ parVectorChunk chunkSize st v = chunkVector :: Int -> Vector a -> [Vector a] chunkVector chunkSize v = do let indices = chunkIndices chunkSize (0,V.length v) - [V.slice l (h-l+1) v | (l,h) <- indices] + [V.slice l (h-l) v | (l,h) <- indices] -- >>> chunkIndices 3 (0,9) -- >>> chunkIndices 3 (0,10) From 0bdc7b5557ce950293d52ddc02158a2b458d0e63 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 25 Sep 2021 08:46:52 +0200 Subject: [PATCH 4/7] redundant import --- ghcide/src/Text/Fuzzy/Parallel.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index 7a48bb3db0..ef5e095ceb 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -16,7 +16,6 @@ import qualified Data.Vector as V -- need to use a stable sort import Data.Bifunctor (second) import Data.Maybe (fromJust) -import qualified Data.Monoid.Factorial as T import Prelude hiding (filter) import Text.Fuzzy (Fuzzy (..), match) From 9d98199a3d1bb5f7e8b2499893c680ffcf8dd27e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 25 Sep 2021 09:20:20 +0200 Subject: [PATCH 5/7] bump ghcide version number --- ghcide/ghcide.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 30a39ba038d29590c74975db262dd3e16d064022 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 26 Sep 2021 21:27:38 +0200 Subject: [PATCH 6/7] cleanup --- ghcide/src/Text/Fuzzy/Parallel.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/ghcide/src/Text/Fuzzy/Parallel.hs b/ghcide/src/Text/Fuzzy/Parallel.hs index ef5e095ceb..700cad4596 100644 --- a/ghcide/src/Text/Fuzzy/Parallel.hs +++ b/ghcide/src/Text/Fuzzy/Parallel.hs @@ -20,18 +20,6 @@ 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. --- --- >>> map (\x -> score <$> match ("lookup"::String) x "" "" id False) ["splitLookup"::String, "lookupInput"] --- WAS WAS WAS WAS NOW [Just 58,Just 120] --- WAS WAS WAS NOW [Just 58,Just 120] --- WAS WAS NOW [Just 58,Just 120] --- WAS NOW [Just 58,Just 120] --- NOW [Just 58,Just 120] --- >>> take 10 $ iterate (\(tot, cur) -> let cur' = 2*cur + 1 in (tot + cur', cur')) (0,0) --- NOW [(0,0),(1,1),(4,3),(11,7),(26,15),(57,31),(120,63),(247,127),(502,255),(1013,511)] - --- >>> 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 @@ -110,8 +98,6 @@ 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 3 5 $ V.fromList $ map (\x -> Fuzzy x x (length x)) ["A","B","ABCDE","ABBC"] --- [Fuzzy {original = "ABCDE", rendered = "ABCDE", score = 5},Fuzzy {original = "ABBC", rendered = "ABBC", score = 4},Fuzzy {original = "A", rendered = "A", score = 1}] partialSortByAscScore :: TextualMonoid s => Int -- ^ Number of items needed -> Int -- ^ Value of a perfect score From e11e69e11cc468801586443068f265a07edcda58 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 26 Sep 2021 21:34:58 +0200 Subject: [PATCH 7/7] fix a test --- ghcide/test/exe/Main.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f1599baf25..df05cf6623 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 @@ -4627,7 +4628,7 @@ projectCompletionTests = <- compls , _label == "anidentifier" ] - liftIO $ compls' @?= ["Defined in 'A"], + liftIO $ compls' @?= ["Defined in 'A"], testSession' "auto complete project imports" $ \dir-> do liftIO $ writeFile (dir "hie.yaml") "cradle: {direct: {arguments: [\"-Wmissing-signatures\", \"ALocalModule\", \"B\"]}}"