fuzzily 0.2.0.0 → 0.2.1.0
raw patch · 3 files changed
+251/−199 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.Fuzzily: matchOnce :: TextualMonoid text => (Char -> Char) -> (text, text) -> text -> text -> Maybe (text, Int)
Files
- fuzzily.cabal +2/−2
- src/Text/Fuzzily.hs +69/−46
- tests/tests.hs +180/−151
fuzzily.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: fuzzily-version: 0.2.0.0+version: 0.2.1.0 synopsis: Filters a list based on a fuzzy string search description: Fuzzily is a library that filters a list based on a fuzzy string search. Uses 'TextualMonoid' to be able to run on different types of strings.
src/Text/Fuzzily.hs view
@@ -4,14 +4,16 @@ -} module Text.Fuzzily where -import Protolude as P (+import Protolude ( Bool (True),+ Char, Down (Down), Eq ((==)), Int, Maybe (..), Monoid (mempty), Num ((*), (+)),+ Ord ((>)), Semigroup ((<>)), Show, const,@@ -20,6 +22,7 @@ map, mapMaybe, not,+ otherwise, sortOn, toLower, (.),@@ -53,6 +56,44 @@ {-|+Run one-pass algorithm on the given search text.+Returns (rendered, score) if the whole pattern was consumed.+-}+matchOnce+ :: (T.TextualMonoid text)+ => (Char -> Char)+ -- ^ normalisation function+ -> (text, text)+ -- ^ (pre, post)+ -> text+ -- ^ pattern+ -> text+ -- ^ search text+ -> Maybe (text, Int)+ -- ^ (rendered, score)+matchOnce norm (pre, post) pat txt = do+ let+ (tot, _, res, restPat) =+ T.foldl_'+ ( \(tot_, cur, acc, p) c -> case T.splitCharacterPrefix p of+ Nothing -> (tot_, 0, acc <> T.singleton c, p)+ Just (x, xs)+ | norm x == norm c ->+ let cur' = cur * 2 + 1+ in ( tot_ + cur'+ , cur'+ , acc <> pre <> T.singleton c <> post+ , xs+ )+ | otherwise -> (tot_, 0, acc <> T.singleton c, p)+ )+ (0, 0, mempty, pat)+ txt++ if null restPat then Just (res, tot) else Nothing+++{-| Returns the rendered output and the matching score for a pattern and a text. Two examples are given below:@@ -71,7 +112,7 @@ , score = 5 }) -}-{-# INLINABLE match #-}+{-# INLINEABLE match #-} match :: (T.TextualMonoid text) => CaseSensitivity@@ -86,46 +127,28 @@ -- ^ Value containing the text to search in -> Maybe (Fuzzy value text) -- ^ Original value, rendered string, and score-match caseSensitivity (pre, post) extractFunc pattern value = do+match caseSen preAndPost extract pat value = do let- normFunc = if caseSensitivity == HandleCase- then identity- else toLower+ norm = if caseSen == HandleCase then identity else toLower+ searchText = extract value - searchText = extractFunc value+ -- iterate over every suffix while carrying the already-passed prefix+ go pref txt best =+ case matchOnce norm preAndPost pat txt of+ Just (rendSub, sc) ->+ let cand = Fuzzy value (pref <> rendSub) sc+ best' = chooseBetter cand best+ in step best'+ Nothing -> step best+ where+ step b = case T.splitCharacterPrefix txt of+ Nothing -> b+ Just (c, rest') -> go (pref <> T.singleton c) rest' b - (totalScore, _, result, patternFromFold) =- T.foldl_'- ( \(tot, cur, res, pat) c ->- case T.splitCharacterPrefix pat of- Nothing ->- ( tot- , 0- , res <> T.singleton c- , pat- )- Just (x, xs) ->- if normFunc x == normFunc 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)- searchText+ chooseBetter n Nothing = Just n+ chooseBetter n (Just o) = if score n > score o then Just n else Just o - if null patternFromFold- then Just (Fuzzy value result totalScore)- else Nothing+ go mempty searchText Nothing {-|@@ -145,7 +168,7 @@ } ] -}-{-# INLINABLE filter #-}+{-# INLINEABLE filter #-} filter :: (T.TextualMonoid text) => CaseSensitivity@@ -160,11 +183,11 @@ -- ^ List of values containing the text to search in -> [Fuzzy value text] -- ^ List of results, sorted, highest score first-filter caseSen (pre, post) extractFunc pattern texts =+filter caseSen (pre, post) extractFunc textPattern texts = sortOn (Down . score) ( mapMaybe- (match caseSen (pre, post) extractFunc pattern)+ (match caseSen (pre, post) extractFunc textPattern) texts ) @@ -177,7 +200,7 @@ >>> simpleFilter "vm" ["vim", "emacs", "virtual machine"] ["vim","virtual machine"] -}-{-# INLINABLE simpleFilter #-}+{-# INLINEABLE simpleFilter #-} simpleFilter :: (T.TextualMonoid text) => text@@ -186,10 +209,10 @@ -- ^ List of texts to check. -> [text] -- ^ The ones that match.-simpleFilter pattern xs =+simpleFilter textPattern xs = map original- (filter IgnoreCase (mempty, mempty) identity pattern xs)+ (filter IgnoreCase (mempty, mempty) identity textPattern xs) {-|@@ -200,5 +223,5 @@ True -} test :: (T.TextualMonoid text) => text -> text -> Bool-test pattern text =- isJust (match IgnoreCase (mempty, mempty) identity pattern text)+test textPattern text =+ isJust (match IgnoreCase (mempty, mempty) identity textPattern text)
tests/tests.hs view
@@ -7,13 +7,13 @@ Int, Maybe (Just, Nothing), Monad (return),- Ord ((>)), fst, head, identity, map, ($), (<$>),+ (<>), ) import Test.HUnit (Assertion, Test (..), runTestTT, (@?=))@@ -31,172 +31,201 @@ from xs = TestList (map TestCase xs) -tests :: Test+tests :: [Test] tests =- TestList- [ TestLabel "test" $- TestList- [ TestLabel "returns true when fuzzy match" $- from- [ Fu.test "back" "imaback" @?= True- , Fu.test "back" "bakck" @?= True- , Fu.test "shig" "osh kosh modkhigow" @?= True- , Fu.test "" "osh kosh modkhigow" @?= True- ]- , TestLabel "should return false when no fuzzy match" $- from- [ Fu.test "back" "abck" @?= False- , Fu.test "okmgk" "osh kosh modkhigow" @?= False- ]- ]- , TestLabel "match" $- TestList- [ TestLabel- "returns a greater score for consecutive matches of pattern"- $ from- [ (>)- (Fu.score <$> Fu.match IgnoreCase ("", "") identity "abcd" "zabcd")- (Fu.score <$> Fu.match IgnoreCase ("", "") identity "abcd" "azbcd")- @?= True+ [ TestLabel "test" $+ TestList+ [ TestLabel "returns true when fuzzy match" $+ from+ [ Fu.test "back" "imaback" @?= True+ , Fu.test "back" "bakck" @?= True+ , Fu.test "shig" "osh kosh modkhigow" @?= True+ , Fu.test "" "osh kosh modkhigow" @?= True+ ]+ , TestLabel "should return false when no fuzzy match" $+ from+ [ Fu.test "back" "abck" @?= False+ , Fu.test "okmgk" "osh kosh modkhigow" @?= False+ ]+ ]+ , TestLabel "match" $+ TestList+ [ TestLabel+ "returns a greater score for continuous matches of pattern"+ $ from+ $ let+ scoreContinuousMatch =+ Fu.score+ <$> Fu.match IgnoreCase ("", "") identity "abcd" "zabcd"+ scoreSplitMatch =+ Fu.score+ <$> Fu.match IgnoreCase ("", "") identity "abcd" "azbcd"+ in+ [ scoreContinuousMatch @?= Just 26+ , scoreSplitMatch @?= Just 12 ]- , TestLabel- "returns the string as is if no pre/post and case sensitive"- $ from- [ Fu.rendered+ , TestLabel+ "returns the longest continuous match, even if it's at the end"+ $ from+ $ let+ actual =+ Fu.rendered <$> Fu.match- HandleCase- ("", "")+ IgnoreCase+ ("<", ">") identity- "ab"- "ZaZbZ"- @?= Just "ZaZbZ"- ]- , TestLabel "returns Nothing on no match" $- from- [ Fu.match- IgnoreCase+ "abcd"+ "This is a sizeable text with a final matching word: abcd"+ expected =+ Just $+ "This is a sizeable text"+ <> " with a final matching word: <a><b><c><d>"+ in+ [actual @?= expected]+ , TestLabel+ "returns the string as is if no pre/post and case sensitive"+ $ from+ [ Fu.rendered+ <$> Fu.match+ HandleCase ("", "") identity- "ZEBRA!"+ "ab" "ZaZbZ"- @?= Nothing- ]- , TestLabel "is case sensitive if specified" $- from- [ Fu.match+ @?= Just "ZaZbZ"+ ]+ , TestLabel "returns Nothing on no match" $+ from+ [ Fu.match+ IgnoreCase+ ("", "")+ identity+ "ZEBRA!"+ "ZaZbZ"+ @?= Nothing+ ]+ , TestLabel "is case sensitive if specified" $+ from+ [ Fu.match+ HandleCase+ ("", "")+ identity+ "hask"+ "Haskell"+ @?= Nothing+ ]+ , TestLabel "wraps pre and post around matches" $+ from+ [ Fu.rendered+ <$> Fu.match HandleCase- ("", "")+ ("<", ">") identity- "hask"- "Haskell"- @?= Nothing- ]- , TestLabel "wraps pre and post around matches" $- from- [ Fu.rendered- <$> Fu.match+ "brd"+ "bread"+ @?= Just "<b><r>ea<d>"+ ]+ ]+ , TestLabel "filter" $+ TestList+ [ TestLabel "returns list untouched when given empty pattern" $+ from+ [ ( Fu.original+ `map` Fu.filter HandleCase- ("<", ">")+ ("", "") identity- "brd"- "bread"- @?= Just "<b><r>ea<d>"- ]- ]- , TestLabel "filter" $- TestList- [ TestLabel "returns list untouched when given empty pattern" $- from- [ ( Fu.original- `map` ( Fu.filter- HandleCase- ("", "")- identity- ""- ["abc", "def"]- )- )- @?= ["abc", "def"]- ]- , TestLabel "returns the highest score first" $- from- [ (@?=)- (head (Fu.filter HandleCase ("", "") identity "cb" ["cab", "acb"]))- (head (Fu.filter HandleCase ("", "") identity "cb" ["acb"]))- ]- , TestLabel "keeps original casing when filtering case insensitive" $- from- [ ( Fu.original- `map` ( Fu.filter- IgnoreCase- ("", "")- identity- "abc"- ["aBc"]- )- )- @?= ["aBc"]- ]- ]- , TestLabel "README examples" $- TestList- [ TestLabel "hsk" $- from- [ ( match- IgnoreCase- ("<", ">")- fst- "hsk"- ("Haskell", 1995 :: Int)+ ""+ ["abc", "def"]+ )+ @?= ["abc", "def"]+ ]+ , TestLabel "returns the highest score first" $+ from+ [ (@?=)+ ( head $+ Fu.filter+ HandleCase+ ("", "")+ identity+ "cb"+ ["cab", "acb"] )- @?= Just- ( Fuzzy- { original = ("Haskell", 1995)- , rendered = "<H>a<s><k>ell"- , score = 5- }- )- ]- , TestLabel "langs" $- from- [ let- langs :: [([Char], Int)]- langs =- [ ("Standard ML", 1990)- , ("OCaml", 1996)- , ("Scala", 2003)- ]- result = filter IgnoreCase ("<", ">") fst "ML" langs- expected =- [ Fuzzy- { original = ("Standard ML", 1990)- , rendered = "Standard <M><L>"- , score = 4- }- , Fuzzy- { original = ("OCaml", 1996)- , rendered = "OCa<m><l>"- , score = 4- }- ]- in- result @?= expected- ]- , TestLabel "simple filter" $- from- [ simpleFilter "vm" ["vim", "emacs", "virtual machine"]- @?= ["vim", "virtual machine"]- ]- , TestLabel "test" $- from- [test "brd" "bread" @?= True]- ]- ]+ (head $ Fu.filter HandleCase ("", "") identity "cb" ["acb"])+ ]+ , TestLabel "keeps original casing when filtering case insensitive" $+ from+ [ ( Fu.original+ `map` ( Fu.filter+ IgnoreCase+ ("", "")+ identity+ "abc"+ ["aBc"]+ )+ )+ @?= ["aBc"]+ ]+ ]+ , TestLabel "README examples" $+ TestList+ [ TestLabel "hsk" $+ from+ [ ( match+ IgnoreCase+ ("<", ">")+ fst+ "hsk"+ ("Haskell", 1995 :: Int)+ )+ @?= Just+ ( Fuzzy+ { original = ("Haskell", 1995)+ , rendered = "<H>a<s><k>ell"+ , score = 5+ }+ )+ ]+ , TestLabel "langs" $+ from+ [ let+ langs :: [([Char], Int)]+ langs =+ [ ("Standard ML", 1990)+ , ("OCaml", 1996)+ , ("Scala", 2003)+ ]+ result = filter IgnoreCase ("<", ">") fst "ML" langs+ expected =+ [ Fuzzy+ { original = ("Standard ML", 1990)+ , rendered = "Standard <M><L>"+ , score = 4+ }+ , Fuzzy+ { original = ("OCaml", 1996)+ , rendered = "OCa<m><l>"+ , score = 4+ }+ ]+ in+ result @?= expected+ ]+ , TestLabel "simple filter" $+ from+ [ simpleFilter "vm" ["vim", "emacs", "virtual machine"]+ @?= ["vim", "virtual machine"]+ ]+ , TestLabel "test" $+ from+ [test "brd" "bread" @?= True]+ ]+ ] runTests :: IO () runTests = do- _ <- runTestTT tests+ _ <- runTestTT $ TestList tests return ()