banwords 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+62/−26 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +25/−0
• banwords.cabal +1/−1
• src/Heuristics/BanWords.hs +25/−21
• tests/Unit.hs +11/−4

@@ -1,3 +1,28 @@ # Intro  A few tools for checking if a word is a close match against a blacklist.++# Example++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Monoid+import Data.Text (Text)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Heuristics.BanWords++main :: IO ()+main =+  case passBlacklist banAlmostExact blacklist "acme " of+    Nothing -> putStrLn "Blocked 'acme '"+    Just _  -> error "This shouldn't happen!"++blacklist :: Vector Text+blacklist = exampleReserved -- Includes "admin", "security", and a few others.+         <> V.fromList ["gosh", "darn"] -- Supply your own profanity list.+         <> V.fromList ["acme"] -- Prevent users from impersonating your company.+```

@@ -1,5 +1,5 @@ name:                 banwords-version:              0.1.0.0+version:              0.2.0.0 author:               Ian Grant Jeffries maintainer:           ian@housejeffries.com category:             Heuristics

@@ -1,40 +1,44 @@ module Heuristics.BanWords where -import Prelude hiding (notElem)- import Control.Applicative import Data.Attoparsec.Text+import Data.Char import Data.Foldable import Data.Monoid import Data.Text (Text) import Data.Vector (Vector) import qualified Data.Vector as V --- | Block exact matches.-passesBlacklist :: Vector Text -> Text -> Maybe Text-passesBlacklist blacklist t =-  case parseOnly (banExact blacklist) t of-    Right _ -> Nothing-    Left _  -> Just t+newtype MatchPolicy = MatchPolicy { _unMatchPolicy :: Vector Text -> Parser Text } --- | Intended for internal use.-banExact :: Vector Text -> Parser Text-banExact bans = asum $ (\x -> string x *> endOfInput *> return x) <$> bans+instance Monoid MatchPolicy where+  mempty = MatchPolicy . const $ empty+  mappend f g = MatchPolicy $ \x -> _unMatchPolicy f x <|> _unMatchPolicy g x --- | Block exact matches, or exact matches that are surrounded by only non-alphabetical characters.-passesBlacklistPlus :: Vector Text -> Text -> Maybe Text-passesBlacklistPlus blacklist t =-  case parseOnly (banAlmostExact blacklist) t of+passBlacklist :: MatchPolicy -> Vector Text -> Text -> Maybe Text+passBlacklist f blacklist t =+  case parseOnly (_unMatchPolicy f blacklist) t of     Right _ -> Nothing     Left _  -> Just t --- | Intended for internal use.-banAlmostExact :: Vector Text -> Parser Text-banAlmostExact bans = asum $ (\x -> skipNonAlphabetical *> string x *> skipNonAlphabetical *> endOfInput *> return x) <$> bans+-- | Parses sucessfully (which means the word gets blocked) if any of the Texts+-- in the blacklist are an exact match.+banExact :: MatchPolicy+banExact = MatchPolicy $ \blacklist -> asum $ (\x -> string x *> endOfInput *> return x) <$> blacklist --- | Intended for internal use.-skipNonAlphabetical :: Parser ()-skipNonAlphabetical = skipWhile $ \c -> notElem c (['a'..'z'] <> ['A'..'Z'])+-- | Parses sucessfully (which means the word gets blocked) if any of the Texts+-- in the blacklist are a match.+--+-- Case is ignored for ASCII characters. Non-alphabetic Unicode characters at+-- either the start of the end of the word can be skipped.+--+-- E.g. " Admin" is banned against ["admin"], but "a admin" isn't.+banAlmostExact :: MatchPolicy+banAlmostExact = MatchPolicy $ \blacklist ->+  asum $ (\x -> skipNonAlphabetical *> asciiCI x *> skipNonAlphabetical *> endOfInput *> return x) <$> blacklist+  where+    skipNonAlphabetical :: Parser ()+    skipNonAlphabetical = skipWhile $ not . isAlpha  exampleReserved :: Vector Text exampleReserved = V.fromList

@@ -22,16 +22,23 @@   ]  exactAcceptable :: Assertion-exactAcceptable = V.mapM_ (assertAllowed $ passesBlacklist exampleReserved) $ goodWords <> goodExtraChars <> badExtraChars+exactAcceptable =+  V.mapM_ (assertAllowed $ passBlacklist banExact exampleReserved)+    $ goodWords <> goodExtraChars <> badExtraChars <> V.fromList ["Hill, Admin"]  exactUnacceptable :: Assertion-exactUnacceptable = V.mapM_ (assertBanned $ passesBlacklist exampleReserved) (V.fromList ["admin", "security"])+exactUnacceptable =+  V.mapM_ (assertBanned $ passBlacklist banExact exampleReserved)+    $ V.fromList ["admin", "security"]  almostAcceptable :: Assertion-almostAcceptable = V.mapM_ (assertAllowed $ passesBlacklistPlus exampleReserved) $ goodWords <> goodExtraChars+almostAcceptable =+  V.mapM_ (assertAllowed $ passBlacklist banAlmostExact exampleReserved)+    $ goodWords <> goodExtraChars <> V.singleton "Hill"  almostUnacceptable :: Assertion-almostUnacceptable = V.mapM_ (assertBanned $ passesBlacklistPlus exampleReserved) badExtraChars+almostUnacceptable = V.mapM_ (assertBanned $ passBlacklist banAlmostExact exampleReserved)+  $ badExtraChars <> V.singleton "Admin"  goodExtraChars :: Vector Text goodExtraChars = V.fromList