BanWords.hs

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"
  ]