diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/eros.cabal b/eros.cabal --- a/eros.cabal +++ b/eros.cabal @@ -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 . - + . I converted the phraselists into JSON. You can view the converted phraselists . - + . 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 - . + 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 diff --git a/src/Text/Eros.hs b/src/Text/Eros.hs new file mode 100644 --- /dev/null +++ b/src/Text/Eros.hs @@ -0,0 +1,129 @@ +{-| +Module : Text.Eros +Description : Capstone Module for eros +Copyright : 2014, Peter Harpending. +License : BSD3 +Maintainer : Peter Harpending +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 diff --git a/src/Text/Eros.lhs b/src/Text/Eros.lhs deleted file mode 100644 --- a/src/Text/Eros.lhs +++ /dev/null @@ -1,22 +0,0 @@ -| -Module : Text.Eros -Description : Capstone Module for eros -Copyright : 2014, Peter Harpending. -License : BSD3 -Maintainer : Peter Harpending -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 diff --git a/src/Text/Eros/Message.hs b/src/Text/Eros/Message.hs --- a/src/Text/Eros/Message.hs +++ b/src/Text/Eros/Message.hs @@ -1,17 +1,19 @@ --- | --- Module : Text.Eros.Message --- Description : Module for censoring pieces of text. --- Copyright : 2014, Peter Harpending --- License : BSD3 --- Maintainer : Peter Harpending --- Stability : experimental --- Portability : archlinux +{- | +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'. +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 + ] diff --git a/src/Text/Eros/Phraselist.hs b/src/Text/Eros/Phraselist.hs --- a/src/Text/Eros/Phraselist.hs +++ b/src/Text/Eros/Phraselist.hs @@ -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]