-- | -- Module : Text.Eros.Message -- Description : Module for censoring pieces of text. -- Copyright : 2014, Peter Harpending -- License : BSD3 -- Maintainer : Peter Harpending -- Stability : experimental -- Portability : archlinux -- This module deals specifically with pieces of 'Text'. module Text.Eros.Message (Message, RestOf, Score, messageScore) where -- Here, we have all the imports. import Data.List import qualified Data.Map.Strict as M import qualified Data.Text.Lazy as L import Data.Tree import Text.Eros.Phrase import Text.Eros.Phraselist -- |I can never remember what I named things, so here are a bunch of -- type synonyms. type BadWord = L.Text type Message = L.Text type MessagePart = L.Text type Restof = L.Text type RestOf = L.Text type Word = L.Text type Score = Int -- |Does a top-level split of a 'Message'. Returns a list of pairs, -- with the first element being the score up to that point in the -- message, as well as the rest of the message. That gives you -- somewhat of an idea how it works, but that's not quite it messageSplit :: Message -> PhraseMap -> [(Score, RestOf)] messageSplit initialText sayingsMap = concat $ filter (/= []) $ nub $ map breakSaying potentialSayings where potentialSayings = M.keys sayingsMap breakSaying saying = map (trimSaying saying . snd) $ broked saying trimSaying saying txt = (sayScore saying, L.strip $ L.drop (L.length saying) txt) sayScore saying = case maybeScore saying of Just score -> score Nothing -> 0 maybeScore saying = fmap score $ fmap rootLabel $ M.lookup saying sayingsMap broked saying = L.breakOnAll saying lowerText -- looks like [("go ", "fuck yourself ")] lowerText = L.toLower initialText -- looks like "go fuck yourself" (compared to "gO fUcK yOURSelf") trimPair (a, b) = (L.strip a, L.strip b) -- looks like ("go", "fuck yourself") -- |Given a message, find its score. messageScore :: Message -> PhraseMap -> Score messageScore msg pmap | L.empty == msg = 0 | otherwise = (sum topScores) + (sum lowerScores) where msgSplit = messageSplit msg pmap topScores = map fst msgSplit lowerScores = map (\m -> messageScore m pmap) $ map snd msgSplit