eros 0.5.0.0 → 0.6.0.0
raw patch · 6 files changed
Files
- README.md +0/−24
- eros.cabal +15/−12
- src/Text/Eros.hs +129/−0
- src/Text/Eros.lhs +0/−22
- src/Text/Eros/Message.hs +83/−42
- src/Text/Eros/Phraselist.hs +2/−63
README.md view
@@ -9,30 +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.0.0--This is a usage guide for version 0.5.0.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).- # Contributing I would love if people would contribute. QuickCheck tests are desperately
eros.cabal view
@@ -1,16 +1,19 @@ name: eros-version: 0.5.0.0+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@@ -30,21 +33,21 @@ library exposed-modules:- Text.Eros- other-modules: Paths_eros+ , Text.Eros , Text.Eros.Message , Text.Eros.Phrase , Text.Eros.Phraselist+ other-modules: other-extensions: FlexibleInstances , OverloadedStrings build-depends:- aeson- , base >=4.7 && <4.8- , bytestring- , containers- , text+ aeson >=0.8 && <0.9+ , base >=4.6 && <4.8+ , bytestring >=0.10 && <0.11+ , containers >=0.5 && <0.6+ , text >=1.1 && <1.2 hs-source-dirs: src/ default-language: Haskell2010
+ src/Text/Eros.hs view
@@ -0,0 +1,129 @@+{-|+Module : Text.Eros+Description : Capstone Module for eros+Copyright : 2014, Peter Harpending.+License : BSD3+Maintainer : Peter Harpending <pharpend2@gmail.com>+Stability : experimental+Portability : archlinux++This module serves as a bit of a capstone to the whole eros+library. The idea being you can just import this module, and get+all of the functions from all the rest of eros.++You will have to look in the documentation for the sub-modules for+the functions. I haven't quite figured out how to get the+documentation to show up here yet.++= How to use this library++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,++> {\-# 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. ++> 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.++> 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). ++> data MyList = MyList+> instance Phraselist MyList where+> phraselistPath MyList = "/path/to/phraselist"++You can then do the normal stuff with 'messageScore' and 'readPhraseMap'.++-}+module Text.Eros (module Text.Eros) where++import Text.Eros.Message as Text.Eros+import Text.Eros.Phrase as Text.Eros+import Text.Eros.Phraselist as Text.Eros++import qualified Data.Map as Ms+import qualified Data.Text.Lazy as Tl+import Text.Eros.Message+import Text.Eros.Phraselist+import Text.Eros.Phrase
− src/Text/Eros.lhs
@@ -1,22 +0,0 @@-|-Module : Text.Eros-Description : Capstone Module for eros-Copyright : 2014, Peter Harpending.-License : BSD3-Maintainer : Peter Harpending <pharpend2@gmail.com>-Stability : experimental-Portability : archlinux--This module serves as a bit of a capstone to the whole eros-library. The idea being you can just import this module, and get-all of the functions from all the rest of eros.--You will have to look in the documentation for the sub-modules for-the functions. I haven't quite figured out how to get the-documentation to show up here yet.--> module Text.Eros (module Text.Eros) where--> import Text.Eros.Message as Text.Eros-> import Text.Eros.Phrase as Text.Eros-> import Text.Eros.Phraselist as Text.Eros
src/Text/Eros/Message.hs view
@@ -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 (messageScore) where+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+ ]
src/Text/Eros/Phraselist.hs view
@@ -62,7 +62,7 @@ -- |Load a 'Phraselist' directly into a 'PhraseMap' readPhraseMap :: Phraselist t => t -> IO PhraseMap-readPhraseMap plist = fmap mkMap $ readPhraselist plist+readPhraseMap plist = mkMap <$> readPhraselist plist -- |Read the phraselist from disk servePhraselist :: Phraselist t => t -> IO B.ByteString@@ -111,68 +111,7 @@ | WarezHacking | Weapons | Webmail----------------------------------------- Okay, this is the boring stuff -----------------------------------------instance Eq ErosList where- (==) Chat Chat = True- (==) Conspiracy Conspiracy = True- (==) DrugAdvocacy DrugAdvocacy = True- (==) Forums Forums = True- (==) Gambling Gambling = True- (==) Games Games = True- (==) Gore Gore = True- (==) IdTheft IdTheft = True- (==) IllegalDrugs IllegalDrugs = True- (==) Intolerance Intolerance = True- (==) LegalDrugs LegalDrugs = True- (==) Malware Malware = True- (==) Music Music = True- (==) News News = True- (==) Nudism Nudism = True- (==) Peer2Peer Peer2Peer = True- (==) Personals Personals = True- (==) Pornography Pornography = True- (==) Proxies Proxies = True- (==) SecretSocieties SecretSocieties = True- (==) SelfLabeling SelfLabeling = True- (==) Sport Sport = True- (==) Translation Translation = True- (==) UpstreamFilter UpstreamFilter = True- (==) Violence Violence = True- (==) WarezHacking WarezHacking = True- (==) Weapons Weapons = True- (==) Webmail Webmail = True- (==) Chat _ = False- (==) Conspiracy _ = False- (==) DrugAdvocacy _ = False- (==) Forums _ = False- (==) Gambling _ = False- (==) Games _ = False- (==) Gore _ = False- (==) IdTheft _ = False- (==) IllegalDrugs _ = False- (==) Intolerance _ = False- (==) LegalDrugs _ = False- (==) Malware _ = False- (==) Music _ = False- (==) News _ = False- (==) Nudism _ = False- (==) Peer2Peer _ = False- (==) Personals _ = False- (==) Pornography _ = False- (==) Proxies _ = False- (==) SecretSocieties _ = False- (==) SelfLabeling _ = False- (==) Sport _ = False- (==) Translation _ = False- (==) UpstreamFilter _ = False- (==) Violence _ = False- (==) WarezHacking _ = False- (==) Weapons _ = False- (==) Webmail _ = False+ deriving (Eq) -- |A list of phraselists we provide. erosLists :: [ErosList]