packages feed

fuzzy (empty) → 0.1.0.0

raw patch · 5 files changed

+215/−0 lines, 5 filesdep +HUnitdep +basedep +fuzzysetup-changed

Dependencies added: HUnit, base, fuzzy, monoid-subclasses

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Joomy Korkut++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fuzzy.cabal view
@@ -0,0 +1,27 @@+name:                fuzzy+version:             0.1.0.0+synopsis:            Filters a list based on a fuzzy string search.+homepage:            http://github.com/joom/fuzzy+license:             MIT+license-file:        LICENSE+author:              Joomy Korkut+maintainer:          joomy@cattheory.com+category:            Text+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Text.Fuzzy+  build-depends:       base >=4.8 && <5,+                       monoid-subclasses > 0.4+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             tests.hs+  build-depends:       base,+                       fuzzy,+                       HUnit >= 1.2.5.0+  default-language:    Haskell2010
+ src/Text/Fuzzy.hs view
@@ -0,0 +1,105 @@+{-# 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 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 ("<h>a<s><k>ell",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 <m><l>", score = 4},Fuzzy {original = ("OCaml",1996), rendered = "oca<m><l>", 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)++-- | 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.+             -> [s] -- ^ The ones that match.+simpleFilter pattern xs =+  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.+--+-- >>> test "brd" "bread"+-- True+test :: (T.TextualMonoid s)+     => s -> s -> Bool+test p s = isJust (match p s mempty mempty id False)
+ tests/tests.hs view
@@ -0,0 +1,61 @@+module Main where++import qualified Text.Fuzzy as F+import Test.HUnit++from :: [Assertion] -> Test+from xs = TestList (map TestCase xs)++tests :: Test+tests = TestList+  [+    TestLabel "test" $ TestList [+      TestLabel "should return true when fuzzy match" $ from [+        F.test "back" "imaback" @?= True+      , F.test "back" "bakck" @?= True+      , F.test "shig" "osh kosh modkhigow" @?= True+      , F.test "" "osh kosh modkhigow" @?= True+      ]+    , TestLabel "should return false when no fuzzy match" $ from [+        F.test "back" "abck" @?= False+      , F.test "okmgk" "osh kosh modkhigow" @?= False+      ]+    ]+  , TestLabel "match" $ TestList [+      TestLabel "should return a greater score for consecutive matches of pattern" $ from [+        (>) (F.score <$> F.match "abcd" "zabcd" "" "" id False)+            (F.score <$> F.match "abcd" "azbcd" "" "" id False)+        @?= True+      ]+    , TestLabel "should return the string as is if no pre/post and case sensitive" $ from [+        F.rendered <$> F.match "ab" "ZaZbZ" "" "" id True @?= Just "ZaZbZ"+      ]+    , TestLabel "should return Nothing on no match" $ from [+        F.match "ZEBRA!" "ZaZbZ" "" "" id False @?= Nothing+      ]+    , TestLabel "should be case sensitive is specified" $ from [+        F.match "hask" "Haskell" "" "" id True @?= Nothing+      ]+    , TestLabel "should be wrap pre and post around matches" $ from [+        F.rendered <$> F.match "brd" "bread" "<" ">" id True @?= Just "<b><r>ea<d>"+      ]+    ]+  , TestLabel "filter" $ TestList [+      TestLabel "should return list untouched when given empty pattern" $ from [+        map F.original (F.filter "" ["abc", "def"] "" "" id True) @?= ["abc", "def"]+      ]+    , TestLabel "should return the highest score first" $ from [+        (@?=) (head (F.filter "cb" ["cab", "acb"] "" "" id True) )+              (head (F.filter "cb" ["acb"] "" "" id True))+      ]+    ]+  ]++runTests ::  IO ()+runTests = do+  _ <- runTestTT tests+  return ()++-- | For now, main will run our tests.+main :: IO ()+main = runTests