eros 0.5.3.2 → 0.6.0.0

raw patch · 3 files changed

+90/−179 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +0/−133
• eros.cabal +8/−5
• src/Text/Eros/Message.hs +82/−41

@@ -9,139 +9,6 @@ [compressed versions](https://github.com/pharpend/eros/tree/master/res/phraselists-ugly) for use in your code. -Eros is still in development, and is not ready to be actually used. If you would-like to contribute, please do.--You can try the-[API documentation on Hackage](http://hackage.haskell.org/package/eros) if you-want to learn how to use the library. Hackage isn't terribly reliable at-successfully building the documentation, so I also publish the documentation on-[GitHub pages](https://pharpend.github.io/eros-haddock)--# Usage - v.0.5.2.0--This is a usage guide for version 0.5.2.0. There will be more up-to-date usage-guides as more versions come, hopefully.--To install, add `eros >=0.5 && <0.6` to the `build-depends` field in your-library's `.cabal` file--You can get all the functions, simply by `import`ing `Text.Eros`.--Hackage seems to be unable to build the API documentation for Eros, but it won't-hurt to check [eros on Hackage](http://hackage.haskell.org/package/eros).  If-that doesn't work, I publish the documentation-[here](https://pharpend.github.io/eros-haddock).--## Using `Text.Eros`--The basic idea is you take a `Message` type, and check it against a `PhraseMap`,-using `messageScore`. `Message` is actually just a type alias for `Tl.Text`, so-just enable the `OverloadedStrings` extension, and pretend you're using normal-strings.--In GHCi,--`:set -XOverloadedStrings`--`import Text.Eros`--In a file,--``` {.haskell}- {-# LANGUAGE OverloadedStrings #-}- import Text.Eros-```--### Constructing `PhraseMap`s--A `PhraseMap` is just a `Phraselist` marshaled into the more Haskell-friendly-`Ms.Map` type.--Eros provides a large number of `Phraselist`s.--``` {.haskell}- data ErosList = Chat-               | Conspiracy-               | DrugAdvocacy-               | Forums-               | Gambling-               | Games-               | Gore-               | IdTheft-               | IllegalDrugs-               | Intolerance-               | LegalDrugs-               | Malware-               | Music-               | News-               | Nudism-               | Peer2Peer-               | Personals-               | Pornography-               | Proxies-               | SecretSocieties-               | SelfLabeling-               | Sport-               | Translation-               | UpstreamFilter-               | Violence-               | WarezHacking-               | Weapons-               | Webmail-   deriving (Eq)-```--The easiest way to marshal a `Phraselist` into a `PhraseMap` is to use the-`readPhraseMap` function.--``` {.haskell}- readPhraseMap :: Phraselist t => t -> IO PhraseMap-```--Use it like this--`pornMap <- readPhraseMap Pornography`-`30`--Internally, `readPhraseMap` reads JSON data containing the `Phraselist`,-marshals it into a list of `PhraseAlmostTree`s, converts those into a-`PhraseForsest`, and then into a `PhraseMap`.--You can obviously use `mkMap` and `readPhraselist` to do it yourself, but it's a-lot easier to just use `readPhraseMap`.--You can then use `messageScore` to see the `Score` (actually an `Int`) of each-message.--`messageScore "Go fuck yourself." pornMap`--`messageScore` is not case sensitive, so `go fUck YoUrself` returns the same-score as `go fuck yourself`, and so on.--If you want to use multiple eros lists, do something like this--`let myLists = [Chat, Pornography, Weapons]`--`myMaps <- mapM readPhraseMap myLists`--`map (messageScore "Go fuck yourself") myMaps`-`[0, 30, 0]`--### Using your own phraselists--I haven't added *good* support in for this yet, but there still is support-nonetheless. Your phraselist needs to be in JSON, in accordance with the-Phraselist schema (I'm too lazy to find a link to it).--``` {.haskell}- data MyList = MyList- instance Phraselist MyList where-   phraselistPath MyList = "/path/to/phraselist"-```--You can then do the normal stuff with `messageScore` and `readPhraseMap`.- # Contributing  I would love if people would contribute. QuickCheck tests are desperately

@@ -1,16 +1,19 @@ name:                eros-version:             0.5.3.2+version:             0.6.0.0 synopsis:            A text censorship library. description:   A Haskell library for censoring text, using   <http://contentfilter.futuragts.com/phraselists/ DansGuardian phraselists>.-+  .   I converted the phraselists into JSON. You can view the converted phraselists   <https://github.com/pharpend/eros/tree/master/res/phraselists-pretty here>.-+  .   I recommend looking at the API documentation for 'Text.Eros' if you want an-  idea of how to use the library. I publish the documentation-  <https://pharpend.github.io/eros-haddock/ on GitHub>.+  idea of how to use the library.+  .+  Changelog+  .+  [0.6] - Fixed algorithm, added "flat score" for zero-depth message score.  license:             BSD3 license-file:        LICENSE

@@ -1,17 +1,19 @@--- |--- Module       : Text.Eros.Message--- Description  : Module for censoring pieces of text.--- Copyright    : 2014, Peter Harpending--- License      : BSD3--- Maintainer   : Peter Harpending <pharpend2@gmail.com>--- Stability    : experimental--- Portability  : archlinux+{- |+Module       : Text.Eros.Message+Description  : Module for censoring pieces of text.+Copyright    : 2014, Peter Harpending+License      : BSD3+Maintainer   : Peter Harpending <pharpend2@gmail.com>+Stability    : experimental+Portability  : archlinux --- This module deals specifically with pieces of 'Text'.+This module deals specifically with pieces of Text.+-}  module Text.Eros.Message where  -- Here, we have all the imports.+import           Control.Applicative import           Data.List import qualified Data.Map.Strict as M import qualified Data.Text.Lazy as L@@ -22,40 +24,79 @@  -- |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+type BadWord      = L.Text+type Message      = L.Text+type MessagePart  = L.Text+type Multiplicity = Int+type Restof       = L.Text+type RestOf       = L.Text+type Word         = L.Text+type Score        = Int+type SubMap       = PhraseMap --- |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+-- |Given a message, get all the bad words in the message, along with+-- the rest of the message+badWordsRestof :: Message -> PhraseMap -> [(BadWord, Restof)]+badWordsRestof msg pmap = concat keyLists+  where lowerMsg = L.toLower msg+        mapKeys  = M.keys pmap+        keyLists = [ brokenKeys+                   | key <- mapKeys+                   , let keyTuples = L.breakOnAll key lowerMsg+                         restOfs = map snd keyTuples+                         brokenKeys = map (L.splitAt (L.length key)) restOfs+                   , keyTuples /= []+                   ]++-- |Given a message, get all the bad words in the message, along with+-- their multiplicity.+badWordMults :: Message -> PhraseMap -> M.Map BadWord Multiplicity+badWordMults msg pmap = M.fromList keysInMsg   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")+    keysInMsg = [ brokenKeyPairs+                | key <- mapKeys +                , let keyTuples      = L.breakOnAll key lowerMsg+                      restOfs        = map snd keyTuples+                      brokenKeys     = map (L.take (L.length key)) restOfs+                      brokenKeyPairs = (head brokenKeys, length brokenKeys)+                , keyTuples /= []+                ]+    lowerMsg  = L.toLower msg+    mapKeys   = M.keys pmap --- |Given a message, find its score.+-- |Message score flat - no-depth score+messageScore_ :: Message -> PhraseMap -> Score+messageScore_ msg pmap = sum [ (getBadWordScore badwd pmap) * mult+                             | (badwd, mult) <- M.toList $ badWordMults msg pmap+                             ]++getBadWordScore :: BadWord -> PhraseMap -> Score+getBadWordScore badwd pmap = case maybeScore of+                               Just sc -> sc+                               Nothing -> 0+  where maybeScore = score <$> rootLabel <$> M.lookup badwd pmap++getBadWordSubMap :: BadWord -> PhraseMap -> SubMap+getBadWordSubMap badwd pmap = case maybeSubMap of+                               Just mp -> mp+                               Nothing -> M.empty+  where maybeSubMap = mkMap <$> subForest <$> M.lookup badwd pmap++badWordsRestofScoreSubm :: Message -> PhraseMap -> [(BadWord, Restof, Score, SubMap)]+badWordsRestofScoreSubm msg pmap = [ (bdwd, rstof, bws, sbm)+                                   | (bdwd, rstof) <- badWordsRestof msg pmap+                                   , let bws = getBadWordScore bdwd pmap+                                         sbm = getBadWordSubMap bdwd pmap+                                   ]++brss :: Message -> PhraseMap -> [(BadWord, Restof, Score, SubMap)]+brss = badWordsRestofScoreSubm+ 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+  | L.empty == msg  = 0+  | M.empty == pmap = 0+  | otherwise       = sum [ scr + lowerScore+                          | (bdw, rof, scr, sbm) <- brss msg pmap+                          , let lowerScore = messageScore rof sbm+                          ]