fuzzily (empty) → 0.1.0.0
raw patch · 6 files changed
+466/−0 lines, 6 filesdep +HUnitdep +basedep +fuzzilysetup-changed
Dependencies added: HUnit, base, fuzzily, monoid-subclasses, protolude
Files
- README.md +54/−0
- Setup.hs +4/−0
- fuzzily.cabal +62/−0
- license.txt +15/−0
- src/Text/Fuzzily.hs +202/−0
- tests/tests.hs +129/−0
+ README.md view
@@ -0,0 +1,54 @@+# Fuzzily++Fuzzy string search library in Haskell.+Uses `TextualMonoid` from+[monoid-subclasses](https://hackage.haskell.org/package/monoid-subclasses)+to be able to run on different types of strings.++This is a fork of Joomy Korkut's [fuzzy](https://github.com/joom/fuzzy),+which itselft was a port of the JavaScript library+[mattyork/fuzzy](https://github.com/mattyork/fuzzy).++It was initially forked to be used in [TaskLite](https://tasklite.org/)'s+`find` sub-command.+++## Usage++```haskell+> import Text.Fuzzily++> match "fnt" "infinite" ("", "") id HandleCase+Just (Fuzzily+ { original = "infinite"+ , rendered = "infinite"+ , score = 3+ })++> match "hsk" ("Haskell",1995) ("<", ">") fst IgnoreCase+Just (Fuzzily+ { original = ("Haskell", 1995)+ , rendered = "<h>a<s><k>ell"+ , score = 5+ })++> langs = [("Standard ML", 1990), ("OCaml", 1996), ("Scala", 2003)]+> filter "ML" langs ("<", ">") fst IgnoreCase+[ Fuzzily+ { original = ("Standard ML", 1990)+ , rendered = "standard <m><l>"+ , score = 4+ }+, Fuzzily+ { original = ("OCaml", 1996)+ , rendered = "oca<m><l>"+ , score = 4+ }+]++> simpleFilter "vm" ["vim", "emacs", "virtual machine"]+["vim","virtual machine"]++> test "brd" "bread"+True+```
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain
+ fuzzily.cabal view
@@ -0,0 +1,62 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name: fuzzily+version: 0.1.0.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.+category: Text, Fuzzy, Search, Find, Filter+homepage: https://github.com/ad-si/Fuzzily+bug-reports: https://github.com/ad-si/Fuzzily/issues+author: Adrian Sieber+maintainer: mail@adriansieber.com+copyright: Adrian Sieber+license: ISC+license-file: license.txt+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/ad-si/Fuzzily++library+ exposed-modules:+ Text.Fuzzily+ other-modules:+ Paths_fuzzily+ hs-source-dirs:+ src+ default-extensions:+ ImportQualifiedPost+ NoImplicitPrelude+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans+ build-depends:+ base >=4.18.2 && <5+ , monoid-subclasses >=1.2.5 && <1.3+ , protolude >=0.3.4 && <0.4+ default-language: Haskell2010++test-suite fuzzily-test+ type: exitcode-stdio-1.0+ main-is: tests.hs+ other-modules:+ Paths_fuzzily+ hs-source-dirs:+ tests+ default-extensions:+ ImportQualifiedPost+ NoImplicitPrelude+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans+ build-depends:+ HUnit+ , base+ , fuzzily+ , monoid-subclasses >=1.2.5 && <1.3+ , protolude >=0.3.4 && <0.4+ default-language: Haskell2010
+ license.txt view
@@ -0,0 +1,15 @@+ISC License++Copyright (c) 2020 Adrian Sieber++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY+AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.
+ src/Text/Fuzzily.hs view
@@ -0,0 +1,202 @@+{-|+Fuzzy string search in Haskell.+Uses 'TextualMonoid' to be able to run on different types of strings.+-}+module Text.Fuzzily where++import Protolude as P (+ Bool (True),+ Down (Down),+ Eq ((==)),+ Int,+ Maybe (..),+ Monoid (mempty),+ Num ((*), (+)),+ Semigroup ((<>)),+ Show,+ const,+ identity,+ isJust,+ map,+ mapMaybe,+ not,+ sortOn,+ toLower,+ (.),+ )++import Data.Monoid.Textual qualified as T+++{-|+Included in the return type of `match` and `filter`.+Contains the original value given, the rendered string+and the matching score.+-}+data Fuzzy val prettyText = Fuzzy+ { original :: val+ , rendered :: prettyText+ , score :: Int+ }+ deriving (Show, Eq)+++data CaseSensitivity+ = IgnoreCase+ | HandleCase+ deriving (Show, Eq)+++null :: (T.TextualMonoid s) => s -> Bool+null =+ not . T.any (const True)+++{-|+Returns the rendered output and the+matching score for a pattern and a text.+Two examples are given below:++>>> match HandleCase ("", "") identity "fnt" "infinite"+Just (Fuzzy+ { original = "infinite"+ , rendered = "infinite"+ , score = 3+ })++>>> match IgnoreCase ("<", ">") fst "hsk" ("Haskell", 1995)+Just (Fuzzy+ { original = ("Haskell", 1995)+ , rendered = "<h>a<s><k>ell"+ , score = 5+ })+-}+match+ :: (T.TextualMonoid text)+ => CaseSensitivity+ -- ^ Handle or ignore case of search text+ -> (text, text)+ -- ^ Text to add before and after each match+ -> (value -> text)+ -- ^ Function to extract the text from the container+ -> text+ -- ^ Pattern+ -> value+ -- ^ Value containing the text to search in+ -> Maybe (Fuzzy value text)+ -- ^ Original value, rendered string, and score+match caseSensitivity (pre, post) extractFunc pattern value =+ let+ searchText = extractFunc value+ (searchTextNorm, patternNorm) =+ let mapToLower = T.map toLower+ in if caseSensitivity == HandleCase+ then (searchText, pattern)+ else (mapToLower searchText, pattern)++ (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 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, patternNorm)+ searchTextNorm+ in+ if null patternFromFold+ then Just (Fuzzy value result totalScore)+ else Nothing+++{-|+The function to filter a list of values+by fuzzy search on the text extracted from them.++>>> langs = [("Standard ML", 1990), ("OCaml", 1996), ("Scala", 2003)]+>>> filter "ML" langs ("<", ">") fst IgnoreCase+[ Fuzzy+ { original = ("Standard ML", 1990)+ , rendered = "standard <m><l>"+ , score = 4}+, Fuzzy+ { original = ("OCaml", 1996)+ , rendered = "oca<m><l>"+ , score = 4+ }+]+-}+filter+ :: (T.TextualMonoid text)+ => CaseSensitivity+ -- ^ Handle or ignore case of search text+ -> (text, text)+ -- ^ Text to add before and after each match+ -> (value -> text)+ -- ^ Function to extract the text from the container+ -> text+ -- ^ Pattern+ -> [value]+ -- ^ 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 =+ sortOn+ (Down . score)+ ( mapMaybe+ (match caseSen (pre, post) extractFunc pattern)+ texts+ )+++{-|+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 text)+ => text+ -- ^ Pattern to look for.+ -> [text]+ -- ^ List of texts to check.+ -> [text]+ -- ^ The ones that match.+simpleFilter pattern xs =+ map+ original+ (filter IgnoreCase (mempty, mempty) identity pattern xs)+++{-|+Returns false if the pattern and the text do not match at all.+Returns true otherwise.++>>> test "brd" "bread"+True+-}+test :: (T.TextualMonoid text) => text -> text -> Bool+test pattern text =+ isJust (match IgnoreCase (mempty, mempty) identity pattern text)
+ tests/tests.hs view
@@ -0,0 +1,129 @@+module Main where++import Protolude (+ Bool (False, True),+ IO,+ Maybe (Just, Nothing),+ Monad (return),+ Ord ((>)),+ head,+ identity,+ map,+ ($),+ (<$>),+ )++import Test.HUnit (Assertion, Test (..), runTestTT, (@?=))+import Text.Fuzzily as Fu (+ CaseSensitivity (HandleCase, IgnoreCase),+ Fuzzy (original, rendered, score),+ filter,+ match,+ test,+ )+++from :: [Assertion] -> Test+from xs = TestList (map TestCase xs)+++tests :: Test+tests =+ TestList+ [ TestLabel "test" $+ TestList+ [ TestLabel "should return 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+ "should return 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+ "should return the string as is if no pre/post and case sensitive"+ $ from+ [ Fu.rendered+ <$> Fu.match+ HandleCase+ ("", "")+ identity+ "ab"+ "ZaZbZ"+ @?= Just "ZaZbZ"+ ]+ , TestLabel "should return Nothing on no match" $+ from+ [ Fu.match+ IgnoreCase+ ("", "")+ identity+ "ZEBRA!"+ "ZaZbZ"+ @?= Nothing+ ]+ , TestLabel "should be case sensitive is specified" $+ from+ [ Fu.match+ HandleCase+ ("", "")+ identity+ "hask"+ "Haskell"+ @?= Nothing+ ]+ , TestLabel "should be wrap pre and post around matches" $+ from+ [ Fu.rendered+ <$> Fu.match+ HandleCase+ ("<", ">")+ identity+ "brd"+ "bread"+ @?= Just "<b><r>ea<d>"+ ]+ ]+ , TestLabel "filter" $+ TestList+ [ TestLabel "should return list untouched when given empty pattern" $+ from+ [ map+ Fu.original+ (Fu.filter HandleCase ("", "") identity "" ["abc", "def"])+ @?= ["abc", "def"]+ ]+ , TestLabel "should return the highest score first" $+ from+ [ (@?=)+ (head (Fu.filter HandleCase ("", "") identity "cb" ["cab", "acb"]))+ (head (Fu.filter HandleCase ("", "") identity "cb" ["acb"]))+ ]+ ]+ ]+++runTests :: IO ()+runTests = do+ _ <- runTestTT tests+ return ()+++-- | For now, main will run our tests.+main :: IO ()+main = runTests