From 2dc615a9531975ca68f1f4c3175fd621de5f315d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Sep 2021 20:22:48 +0200 Subject: [PATCH 1/4] Inline Text.Fuzzy to add INLINABLE pragmas --- ghcide/ghcide.cabal | 4 +- ghcide/src/Text/Fuzzy.hs | 116 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 119 insertions(+), 1 deletion(-) create mode 100644 ghcide/src/Text/Fuzzy.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index f807faa227..e331be899c 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -50,7 +50,6 @@ library dlist, -- we can't use >= 1.7.10 while we have to use hlint == 3.2.* extra >= 1.7.4 && < 1.7.10, - fuzzy, filepath, fingertree, ghc-exactprint, @@ -64,6 +63,7 @@ library hiedb == 0.4.1.*, lsp-types >= 1.3.0.1 && < 1.4, lsp == 1.2.*, + monoid-subclasses, mtl, network-uri, optparse-applicative, @@ -208,6 +208,8 @@ library Development.IDE.Plugin.Completions.Logic Development.IDE.Session.VersionCheck Development.IDE.Types.Action + Text.Fuzzy + ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors if flag(ghc-patched-unboxed-bytecode) diff --git a/ghcide/src/Text/Fuzzy.hs b/ghcide/src/Text/Fuzzy.hs new file mode 100644 index 0000000000..a758dce4d6 --- /dev/null +++ b/ghcide/src/Text/Fuzzy.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | Fuzzy string search in Haskell. +-- Uses 'TextualMonoid' to be able to run on different types of strings. +module Text.Fuzzy where + +import Prelude hiding (filter) +import qualified Prelude as P + +import Data.Char (toLower) +import Data.List (sortOn) +import Data.Maybe (isJust, mapMaybe) +import Data.Monoid (mempty, (<>)) +import Data.Ord +import Data.String +import Data.Text (Text) + +import qualified Data.Monoid.Textual as T + +-- | Included in the return type of @'match'@ and @'filter'@. +-- Contains the original value given, the rendered string +-- and the matching score. +data (T.TextualMonoid s) => Fuzzy t s = + Fuzzy { original :: t + , rendered :: s + , score :: Int + } deriving (Show, Eq) + +-- | Returns the rendered output and the +-- matching score for a pattern and a text. +-- Two examples are given below: +-- +-- >>> match "fnt" "infinite" "" "" id True +-- Just ("infinite",3) +-- +-- >>> match "hsk" ("Haskell",1995) "<" ">" fst False +-- Just ("aell",5) +-- +match :: (T.TextualMonoid s) + => s -- ^ Pattern. + -> t -- ^ The value containing the text to search in. + -> s -- ^ The text to add before each match. + -> s -- ^ The text to add after each match. + -> (t -> s) -- ^ The function to extract the text from the container. + -> Bool -- ^ Case sensitivity. + -> Maybe (Fuzzy t s) -- ^ The original value, rendered string and score. +match pattern t pre post extract caseSensitive = + if null pat then Just (Fuzzy t result totalScore) else Nothing + where + null :: (T.TextualMonoid s) => s -> Bool + null = not . T.any (const True) + + s = extract t + (s', pattern') = let f = T.map toLower in + if caseSensitive then (s, pattern) else (f s, f pattern) + + (totalScore, currScore, result, pat) = + T.foldl' + undefined + (\(tot, cur, res, pat) c -> + case T.splitCharacterPrefix pat of + Nothing -> (tot, 0, res <> T.singleton c, pat) + Just (x, xs) -> + if x == c then + let cur' = cur * 2 + 1 in + (tot + cur', cur', res <> pre <> T.singleton c <> post, xs) + else (tot, 0, res <> T.singleton c, pat) + ) (0, 0, mempty, pattern') s' + +-- | The function to filter a list of values by fuzzy search on the text extracted from them. +-- +-- >>> filter "ML" [("Standard ML", 1990),("OCaml",1996),("Scala",2003)] "<" ">" fst False +-- [Fuzzy {original = ("Standard ML",1990), rendered = "standard ", score = 4},Fuzzy {original = ("OCaml",1996), rendered = "oca", score = 4}] +filter :: (T.TextualMonoid s) + => s -- ^ Pattern. + -> [t] -- ^ The list of values containing the text to search in. + -> s -- ^ The text to add before each match. + -> 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. +filter pattern ts pre post extract caseSen = + sortOn (Down . score) + (mapMaybe (\t -> match pattern t pre post extract caseSen) ts) + +filterText :: Text -> [Text] -> [Fuzzy Text Text] +filterText s t = filter s t "" "" id False + +{-# SPECIALIZE simpleFilter :: Text -> [Text] -> [Fuzzy Text Text] #-} + +-- | Return all elements of the list that have a fuzzy +-- match against the pattern. Runs with default settings where +-- nothing is added around the matches, as case insensitive. +-- +-- >>> simpleFilter "vm" ["vim", "emacs", "virtual machine"] +-- ["vim","virtual machine"] +simpleFilter :: (T.TextualMonoid s) + => s -- ^ Pattern to look for. + -> [s] -- ^ List of texts to check. + -> [Fuzzy s s] -- ^ The ones that match. +simpleFilter pattern xs = + filter pattern xs mempty mempty id False + +-- | Returns false if the pattern and the text do not match at all. +-- Returns true otherwise. +-- +-- >>> test "brd" "bread" +-- True +test :: (T.TextualMonoid s) + => s -> s -> Bool +test p s = isJust (match p s mempty mempty id False) + + +{-# INLINABLE match #-} +{-# INLINABLE filter #-} +{-# INLINABLE simpleFilter #-} From 0f9f7e6e0979fe9d6356d91e1d1cf2095fa852d9 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Sep 2021 20:29:09 +0200 Subject: [PATCH 2/4] add note --- ghcide/src/Text/Fuzzy.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ghcide/src/Text/Fuzzy.hs b/ghcide/src/Text/Fuzzy.hs index a758dce4d6..2cb3ccd5cc 100644 --- a/ghcide/src/Text/Fuzzy.hs +++ b/ghcide/src/Text/Fuzzy.hs @@ -1,5 +1,10 @@ +-- Copyright (c) 2015 Joomy Korkut +-- Forked from https://github.com/joom/fuzzy/commit/eecbdd04e86c48c964544dbede2665f72fe1f923 +-- temporarily for https://github.com/joom/fuzzy/pull/3 + {-# LANGUAGE FlexibleContexts #-} + -- | Fuzzy string search in Haskell. -- Uses 'TextualMonoid' to be able to run on different types of strings. module Text.Fuzzy where From ac1475e7fba56deffd3a22e900a9decf096794c6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Sep 2021 22:11:45 +0200 Subject: [PATCH 3/4] fixup fuzzy --- ghcide/src/Text/Fuzzy.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Text/Fuzzy.hs b/ghcide/src/Text/Fuzzy.hs index 2cb3ccd5cc..631cf2a3b6 100644 --- a/ghcide/src/Text/Fuzzy.hs +++ b/ghcide/src/Text/Fuzzy.hs @@ -88,11 +88,6 @@ filter pattern ts pre post extract caseSen = sortOn (Down . score) (mapMaybe (\t -> match pattern t pre post extract caseSen) ts) -filterText :: Text -> [Text] -> [Fuzzy Text Text] -filterText s t = filter s t "" "" id False - -{-# SPECIALIZE simpleFilter :: Text -> [Text] -> [Fuzzy Text Text] #-} - -- | Return all elements of the list that have a fuzzy -- match against the pattern. Runs with default settings where -- nothing is added around the matches, as case insensitive. @@ -102,9 +97,9 @@ filterText s t = filter s t "" "" id False simpleFilter :: (T.TextualMonoid s) => s -- ^ Pattern to look for. -> [s] -- ^ List of texts to check. - -> [Fuzzy s s] -- ^ The ones that match. + -> [s] -- ^ The ones that match. simpleFilter pattern xs = - filter pattern xs mempty mempty id False + map original $ filter pattern xs mempty mempty id False -- | Returns false if the pattern and the text do not match at all. -- Returns true otherwise. From 00aee6e82185cfe330a0989aef1603a39c1274bf Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 19 Sep 2021 22:12:07 +0200 Subject: [PATCH 4/4] 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 e331be899c..a8ac2ada44 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.0 +version: 1.4.2.1 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors