module Heuristics.BanWords where import Prelude hiding (notElem) import Control.Applicative import Data.Attoparsec.Text 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 -- | Intended for internal use. banExact :: Vector Text -> Parser Text banExact bans = asum $ (\x -> string x *> endOfInput *> return x) <$> bans -- | 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 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 -- | Intended for internal use. skipNonAlphabetical :: Parser () skipNonAlphabetical = skipWhile $ \c -> notElem c (['a'..'z'] <> ['A'..'Z']) exampleReserved :: Vector Text exampleReserved = V.fromList [ "accounts" , "admin" , "beta" , "billing" , "help" , "jobs" , "mail" , "registration" , "root" , "security" , "support" ]