Skip to content

Commit c790fb2

Browse files
committed
Fuzz in parallel
1 parent 9c324f2 commit c790fb2

File tree

3 files changed

+71
-4
lines changed

3 files changed

+71
-4
lines changed

ghcide/ghcide.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ library
6464
hiedb == 0.4.1.*,
6565
lsp-types >= 1.3.0.1 && < 1.4,
6666
lsp == 1.2.*,
67+
monoid-subclasses,
6768
mtl,
6869
network-uri,
6970
optparse-applicative,
@@ -208,6 +209,8 @@ library
208209
Development.IDE.Plugin.Completions.Logic
209210
Development.IDE.Session.VersionCheck
210211
Development.IDE.Types.Action
212+
Text.Fuzzy.Parallel
213+
211214
ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors
212215

213216
if flag(ghc-patched-unboxed-bytecode)

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import Data.Maybe (fromMaybe, isJust,
2424
listToMaybe,
2525
mapMaybe)
2626
import qualified Data.Text as T
27-
import qualified Text.Fuzzy as Fuzzy
27+
import qualified Text.Fuzzy.Parallel as Fuzzy
2828

2929
import Control.Monad
3030
import Data.Aeson (ToJSON (toJSON))
@@ -53,6 +53,10 @@ import Language.LSP.Types
5353
import Language.LSP.Types.Capabilities
5454
import qualified Language.LSP.VFS as VFS
5555

56+
-- Chunk size used for parallelizing fuzzy matching
57+
chunkSize :: Int
58+
chunkSize = 1000
59+
5660
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
5761

5862
-- | A context of a declaration in the program
@@ -538,9 +542,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
538542
filtModNameCompls =
539543
map mkModCompl
540544
$ mapMaybe (T.stripPrefix enteredQual)
541-
$ Fuzzy.simpleFilter fullPrefix allModNamesAsNS
545+
$ Fuzzy.simpleFilter chunkSize fullPrefix allModNamesAsNS
542546

543-
filtCompls = map Fuzzy.original $ Fuzzy.filter prefixText ctxCompls "" "" label False
547+
filtCompls = map Fuzzy.original $ Fuzzy.filter chunkSize prefixText ctxCompls "" "" label False
544548
where
545549

546550
mcc = case maybe_parsed of
@@ -587,7 +591,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
587591

588592
filtListWith f list =
589593
[ f label
590-
| label <- Fuzzy.simpleFilter fullPrefix list
594+
| label <- Fuzzy.simpleFilter chunkSize fullPrefix list
591595
, enteredQual `T.isPrefixOf` label
592596
]
593597

ghcide/src/Text/Fuzzy/Parallel.hs

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
-- | Parallel versions of 'filter' and 'simpleFilter'
2+
module Text.Fuzzy.Parallel
3+
(
4+
filter,
5+
simpleFilter,
6+
-- reexports
7+
Fuzzy(..),
8+
match
9+
) where
10+
11+
import Control.Parallel.Strategies (Eval, evalTraversable,
12+
parListChunk, rseq, using)
13+
import Data.List (sortOn)
14+
import Data.Maybe (catMaybes)
15+
import Data.Monoid.Textual (TextualMonoid)
16+
import Data.Ord (Down (Down))
17+
import Prelude hiding (filter)
18+
import Text.Fuzzy (Fuzzy (..), match)
19+
20+
-- | Evaluation that forces the 'score' field
21+
forceScore :: TextualMonoid s => Fuzzy t s -> Eval(Fuzzy t s)
22+
forceScore it@Fuzzy{score} = do
23+
score' <- rseq score
24+
return it{score = score'}
25+
26+
-- | The function to filter a list of values by fuzzy search on the text extracted from them.
27+
--
28+
-- >>> filter "ML" [("Standard ML", 1990),("OCaml",1996),("Scala",2003)] "<" ">" fst False
29+
-- [Fuzzy {original = ("Standard ML",1990), rendered = "standard <m><l>", score = 4},Fuzzy {original = ("OCaml",1996), rendered = "oca<m><l>", score = 4}]
30+
{-# INLINABLE filter #-}
31+
filter :: (TextualMonoid s)
32+
=> Int -- ^ Chunk size. 1000 works well.
33+
-> s -- ^ Pattern.
34+
-> [t] -- ^ The list of values containing the text to search in.
35+
-> s -- ^ The text to add before each match.
36+
-> s -- ^ The text to add after each match.
37+
-> (t -> s) -- ^ The function to extract the text from the container.
38+
-> Bool -- ^ Case sensitivity.
39+
-> [Fuzzy t s] -- ^ The list of results, sorted, highest score first.
40+
filter chunkSize pattern ts pre post extract caseSen =
41+
sortOn (Down . score)
42+
(catMaybes
43+
(map (\t -> match pattern t pre post extract caseSen) ts
44+
`using`
45+
parListChunk chunkSize (evalTraversable forceScore)))
46+
47+
-- | Return all elements of the list that have a fuzzy
48+
-- match against the pattern. Runs with default settings where
49+
-- nothing is added around the matches, as case insensitive.
50+
--
51+
-- >>> simpleFilter "vm" ["vim", "emacs", "virtual machine"]
52+
-- ["vim","virtual machine"]
53+
{-# INLINABLE simpleFilter #-}
54+
simpleFilter :: (TextualMonoid s)
55+
=> Int -- ^ Chunk size. 1000 works well.
56+
-> s -- ^ Pattern to look for.
57+
-> [s] -- ^ List of texts to check.
58+
-> [s] -- ^ The ones that match.
59+
simpleFilter chunk pattern xs =
60+
map original $ filter chunk pattern xs mempty mempty id False

0 commit comments

Comments
 (0)