eros 0.3.1.0 → 0.4.0.0
raw patch · 17 files changed
+493/−900 lines, 17 filesdep −QuickCheckdep −aeson-prettydep −erosdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, aeson-pretty, eros
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- README.md +19/−131
- eros.cabal +4/−45
- res/erosc-dummy-inputs/input0.json +0/−7
- res/schemata/erosc-input.json +0/−20
- res/schemata/erosc-output.json +0/−19
- src/Text/Eros.lhs +22/−0
- src/Text/Eros/Message.hs +61/−0
- src/Text/Eros/Phrase.hs +57/−0
- src/Text/Eros/Phraselist.hs +330/−0
- src/client/Erosc/Processor.hs +0/−94
- src/client/Main.lhs +0/−78
- src/library/Text/Eros.lhs +0/−22
- src/library/Text/Eros/Message.hs +0/−61
- src/library/Text/Eros/Phrase.hs +0/−57
- src/library/Text/Eros/Phraselist.hs +0/−330
- test/Main.hs +0/−14
- test/TextErosPhrase.hs +0/−22
README.md view
@@ -12,148 +12,36 @@ Eros is still in development, and is not ready to be actually used. If you would like to contribute, please do. -At the time of this writing, I'm at version 0.3 (see-[here](https://github.com/pharpend/eros/releases)) for the current release.--See the [API documentation on Hackage](http://hackage.haskell.org/package/eros)-if you want to learn how to use the library.+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.3.1.0+# Usage - v.0.4.0.0 This is a usage guide for version 0.3.1.0. There will be more up-to-date usage guides as more versions come, hopefully. -To install, run `cabal install eros`.--## `erosc`--The only way to interact with the library, for the time being is through the-client I built, `erosc`. It accepts input in Javascript Object Notation (JSON)-through `stdin`.--Here is the schema for the input:--```json-{- "name": "erosc-input",- "type": "object",- "description": "The schema for the input to erosc.",- "properties": {- "text": {- "type": "string",- "description": "The text you want to be checked against the phraselists.",- "required": true- },- "eros-lists": {- "type": "array",- "description": "The phraselists provided by eros you want \"text\" to be checked against.",- "required": true,- "items": {- "type": "string"- }- },- }-}-```--That is the up-to-date schema, as of version 0.3.1.0 . It is liable to-change. If the version you downloaded is greater than 0.3.1.0, make sure to-check the schema (it is distributed with the package) to make sure it is up to-date. The schema is located in `res/schemata/erosc-input.json`.--`erosc` will take that input, and send back output in JSON, in accordance with-the schema found in `res/schemata/erosc-output.json`.--```json-{- "name": "erosc-output",- "type": "array",- "description": "The output of erosc.",- "items": {- "type": "object",- "description": "The phraselist name, along with the score for that phraselist.",- "properties": {- "eros-list": {- "type": "string",- "description": "The name of the phraselist corresponding to this object."- },- "score": {- "type": "number",- "description": "The score corresponding to this phraselist."- }- }- }-}-```--## Example--This is the example input from `res/erosc-dummy-inputs/input0.json`.--```json-{- "text": "Fuck you, you fucking fuck! Fucking bitch tits milf sex sluts!",- "eros-lists": [- "gambling",- "pornography"- ]-}-```--Running `erosc < res/erosc-dummy-inputs/input0.json` yields--```json-[- {- "score": 0,- "eros-list": "gambling"- },- {- "score": 11394,- "eros-list": "pornography"- }-]-```--## Library+To install, add `eros >=0.4 && <0.5` to the `build-depends` field in your+library's `.cabal` file -You are welcome to build your own client, and use that. To do so, simply import-`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).+You can get all the functions, simply by `import`ing `Text.Eros`. -If that doesn't work, I publish the documentation+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 -If you want to contribute, you'll need `ghc` and `cabal-install` --0. Clone the git repo-- git clone https://github.com/pharpend/eros.git--1. Install in a sandbox-- cd eros- cabal sandbox init- cabal install --enable-tests--# Planned features--## `erosc` ⟶ `eros-server`--As it stands, `erosc` is tedious and a bit difficult to use. I plan on rewriting-`erosc` to act as an HTTP[s] server, using Happstack, using acid-state as a RAM-cloud. This will be the fastest and easiest to maintain solution.--I will still include an offline client, but it won't be the focus of-development.+I would love if people would contribute. QuickCheck tests are desperately+needed. -## More options+As far as functionality goes, this library is pretty cut & dry. I already added+all of the features I envisioned. -I need to add more filtering options, such as phraselist-specific thresholds,-custom phraselists, and, well, just more stuff.+# Contact -If you have any ideas, please don't hesitate to email me at-<pharpend2@gmail.com>.+The best way to contact me is via IRC. I hang out on `#archlinux` and `#haskell`+on FreeNode. My handles are `l0cust` and `isomorpheous`.
eros.cabal view
@@ -1,5 +1,5 @@ name: eros-version: 0.3.1.0+version: 0.4.0.0 synopsis: A text censorship library. description: A Haskell library for censoring text, using@@ -8,21 +8,10 @@ I converted the phraselists into JSON. You can view the converted phraselists <https://github.com/pharpend/eros/tree/master/res/phraselists-pretty here>. - There exist compressed versions, for use within your code. You can see the- compressed versions- <https://github.com/pharpend/eros/tree/master/res/phraselists-ugly here>.-- The library is not very well tested (or really, tested at all), so I wouldn't- recommend using it for anything important just quite yet. I'm quickly working- towards a stable version, though!-- I recommend looking at the API documentation for Text.Eros if you want an idea- of how to use the library. Hackage seems to be completely unable to build the- documentation for Eros. For that reason, I publish the documentation+ 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>. ---- homepage: https://eros.valkyrian.com/ license: BSD3 license-file: LICENSE author: Peter Harpending@@ -36,7 +25,6 @@ cabal-version: >=1.10 extra-source-files: README.md- res/erosc-dummy-inputs/*.json res/schemata/*.json res/phraselists-pretty/*.json @@ -57,37 +45,8 @@ , bytestring , containers , text- hs-source-dirs: src/library/- default-language: Haskell2010--Test-Suite test-eros- type: exitcode-stdio-1.0- hs-source-dirs: test/- main-is: Main.hs- other-modules:- TextErosPhrase- build-depends:- base- , containers- , eros- , QuickCheck- , text+ hs-source-dirs: src/ default-language: Haskell2010--executable erosc- build-depends:- aeson- , aeson-pretty- , base >=4.7 && <4.8- , bytestring- , containers- , eros- , text- hs-source-dirs: src/client/- main-is: Main.lhs- other-modules: Erosc.Processor- default-language: Haskell2010- ghc-options: -Wall source-repository head type: git
− res/erosc-dummy-inputs/input0.json
@@ -1,7 +0,0 @@-{- "text": "Fuck you, you fucking fuck! Fucking bitch tits milf sex sluts!",- "eros-lists": [- "gambling",- "pornography"- ]-}
− res/schemata/erosc-input.json
@@ -1,20 +0,0 @@-{- "name": "erosc-input",- "type": "object",- "description": "The schema for the input to erosc.",- "properties": {- "text": {- "type": "string",- "description": "The text you want to be checked against the phraselists.",- "required": true- },- "eros-lists": {- "type": "array",- "description": "The phraselists provided by eros you want \"text\" to be checked against.",- "required": true,- "items": {- "type": "string"- }- },- }-}
− res/schemata/erosc-output.json
@@ -1,19 +0,0 @@-{- "name": "erosc-output",- "type": "array",- "description": "The output of erosc.",- "items": {- "type": "object",- "description": "The phraselist name, along with the score for that phraselist.",- "properties": {- "eros-list": {- "type": "string",- "description": "The name of the phraselist corresponding to this object."- },- "score": {- "type": "number",- "description": "The score corresponding to this phraselist."- }- }- }-}
+ src/Text/Eros.lhs view
@@ -0,0 +1,22 @@+|+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
@@ -0,0 +1,61 @@+-- |+-- 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'.++module Text.Eros.Message (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
+ src/Text/Eros/Phrase.hs view
@@ -0,0 +1,57 @@+-- |+-- Module : Text.Eros.Phrase+-- Description : Pure interface for 'Phrase's and 'PhraseTree's.+-- Copyright : 2014, Peter Harpending.+-- License : BSD3+-- Maintainer : Peter Harpending <pharpend2@gmail.com>+-- Stability : experimental+-- Portability : archlinux+-- ++module Text.Eros.Phrase where++import qualified Data.Map as M+import Data.Ord (comparing)+import Data.Text.Lazy (Text)+import Data.Tree++-- |A Phrase is a piece of Text, with an int representing its+-- weight. These are the used internally within 'eros', in+-- 'Tree's. +data Phrase = Phrase { phrase :: Text+ , score :: Int+ }+ deriving (Read, Show)++instance Eq Phrase where+ a == b = (score a) == (score b)+ a /= b = (score a) /= (score b)++instance Ord Phrase where+ -- |To compare 'Phrases', just compare their 'score's+ compare = comparing score++-- |A 'Tree' of 'Phrase's+type PhraseTree = Tree Phrase+-- |A 'Forest' of 'Phrase's+type PhraseForest = Forest Phrase+-- |A Map of text values the appropriate tree+type PhraseMap = M.Map Text PhraseTree++-- |The 'score' of the 'PhraseTree' is the sum of the 'score's of its 'Node's.+treeScore :: PhraseTree -> Int+treeScore = sum . map score . flatten++-- |Given a list of 'PhraseTree's, return the top-level 'phrase's.+forestPhrases :: [PhraseTree] -> [Text]+forestPhrases = map forestPhrase++-- |Given a 'PhraseTree', return the top-level 'phrase'.+forestPhrase :: PhraseTree -> Text+forestPhrase (Node phr subf) = phrase phr++-- |Given a list of 'PhraseTree's, return a map of each phrase with+-- the appropriate tree.+mkMap :: PhraseForest -> PhraseMap+mkMap = M.fromList . phraseTreeAlist+ where phraseTreeAlist frs = zip (forestPhrases frs) frs
+ src/Text/Eros/Phraselist.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module : Text.Eros.Phraselist+-- Description : A module for dealing with Phraselists.+-- Copyright : 2014, Peter Harpending.+-- License : BSD3+-- Maintainer : Peter Harpending <pharpend2@gmail.com>+-- Stability : experimental+-- Portability : archlinux+--+-- If you want to make your own phraselist, you need to write a JSON+-- file, in accordance with the+-- <https://raw.githubusercontent.com/pharpend/eros/master/res/phraselist-schema.json schema>.+-- Once you do that, make a data type for your phraselist.+-- Make your data type an instance of 'Phraselist', and you're good to+-- go.+-- +-- For example, let's say your phraselist is @mylist.json@, and it's+-- all in accordance with the schema. Your code would look something+-- like this:+-- +-- @+-- data MyList = MyList+-- +-- instance Phraselist MyList where+-- phraselistPath MyList = getDataFileName "mylist.json"+-- phraselistPath _ = undefined+-- @+-- +-- Don't forget to add @mylist.json@ to @Data-Files@ in your @.cabal@+-- file.+-- +-- If you want to use one of the lists we already supply+-- ++module Text.Eros.Phraselist where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero, sequence)+import Data.Aeson+import qualified Data.ByteString.Lazy as B+import qualified Data.Map as M+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as L+import Data.Tree+import Paths_eros+import System.Exit+import Text.Eros.Phrase++class Phraselist t where+ phraselistPath :: t -> IO FilePath++-- |A set of 'Phraselist's. Note that this is actually a list, and I'm+-- calling it a "set" for purely lexical purposes.+type PhraselistSet = Phraselist t => [t]++-- |The phraselists in @res/@. Each of these constructors correspond+-- to one of the files+-- <https://github.com/pharpend/eros/tree/master/res/phraselists-pretty here>.+-- +-- Gitlab has a terrible interface, so I won't provide links to each+-- one of them.+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++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++-- |A list of phraselists we provide.+erosLists :: [ErosList]+erosLists = [ 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+ ]++-- |A list of the paths to the phraselists we provide.+erosListPaths :: IO [FilePath]+erosListPaths = mapM phraselistPath erosLists++erosListNames :: [L.Text]+erosListNames = [ "chat"+ , "conspiracy"+ , "drug-advocacy"+ , "forums"+ , "gambling"+ , "games"+ , "gore"+ , "id-theft"+ , "illegal-drugs"+ , "intolerance"+ , "legal-drugs"+ , "malware"+ , "music"+ , "news"+ , "nudism"+ , "peer2peer"+ , "personals"+ , "pornography"+ , "proxies"+ , "secret-societies"+ , "self-labeling"+ , "sport"+ , "translation"+ , "upstream-filter"+ , "violence"+ , "warez-hacking"+ , "weapons"+ , "webmail"+ ]++-- |You can't really order the lists, so we won't use 'M.Map'+erosListNamePairs :: [(ErosList, L.Text)]+erosListNamePairs = zip erosLists erosListNames++erosNameByList :: ErosList -> Maybe L.Text+erosNameByList key = lookup key erosListNamePairs++erosNameListMap :: M.Map L.Text ErosList+erosNameListMap = M.fromList $ zip erosListNames erosLists++erosListByName :: L.Text -> Maybe ErosList+erosListByName key = M.lookup key erosNameListMap ++-- These are the data paths for the various PhraseLists+instance Phraselist ErosList where+ phraselistPath Chat = getDataFileName "res/phraselists-ugly/chat.json"+ phraselistPath Conspiracy = getDataFileName "res/phraselists-ugly/conspiracy.json"+ phraselistPath DrugAdvocacy = getDataFileName "res/phraselists-ugly/drug-advocacy.json"+ phraselistPath Forums = getDataFileName "res/phraselists-ugly/forums.json"+ phraselistPath Gambling = getDataFileName "res/phraselists-ugly/gambling.json"+ phraselistPath Games = getDataFileName "res/phraselists-ugly/games.json"+ phraselistPath Gore = getDataFileName "res/phraselists-ugly/gore.json"+ phraselistPath IdTheft = getDataFileName "res/phraselists-ugly/id-theft.json"+ phraselistPath IllegalDrugs = getDataFileName "res/phraselists-ugly/illegal-drugs.json"+ phraselistPath Intolerance = getDataFileName "res/phraselists-ugly/intolerance.json"+ phraselistPath LegalDrugs = getDataFileName "res/phraselists-ugly/legal-drugs.json"+ phraselistPath Malware = getDataFileName "res/phraselists-ugly/malware.json"+ phraselistPath Music = getDataFileName "res/phraselists-ugly/music.json"+ phraselistPath News = getDataFileName "res/phraselists-ugly/news.json"+ phraselistPath Nudism = getDataFileName "res/phraselists-ugly/nudism.json"+ phraselistPath Peer2Peer = getDataFileName "res/phraselists-ugly/peer2peer.json"+ phraselistPath Personals = getDataFileName "res/phraselists-ugly/personals.json"+ phraselistPath Pornography = getDataFileName "res/phraselists-ugly/pornography.json"+ phraselistPath Proxies = getDataFileName "res/phraselists-ugly/proxies.json"+ phraselistPath SecretSocieties = getDataFileName "res/phraselists-ugly/secret-societies.json"+ phraselistPath SelfLabeling = getDataFileName "res/phraselists-ugly/self-labeling.json"+ phraselistPath Sport = getDataFileName "res/phraselists-ugly/sport.json"+ phraselistPath Translation = getDataFileName "res/phraselists-ugly/translation.json"+ phraselistPath UpstreamFilter = getDataFileName "res/phraselists-ugly/upstream-filter.json"+ phraselistPath Violence = getDataFileName "res/phraselists-ugly/violence.json"+ phraselistPath WarezHacking = getDataFileName "res/phraselists-ugly/warez-hacking.json"+ phraselistPath Weapons = getDataFileName "res/phraselists-ugly/weapons.json"+ phraselistPath Webmail = getDataFileName "res/phraselists-ugly/webmail.json"++-- |Placeholder type used to read JSON. The JSON schema (currently, at+-- least) is such that one needs this type to read the JSON. You can+-- use 'fromPAT' to convert this type into a 'PhraseTree'+data PhraseAlmostTree = PhraseAlmostTree { patPhrase :: Text+ , patScore :: Int+ , patForest :: [PhraseAlmostTree]+ }+ deriving (Show, Read)++-- |Alias for 'PhraseAlmostTree'+type PAT = PhraseAlmostTree++-- |You can read the+-- <https://raw.githubusercontent.com/pharpend/eros/master/res/phraselist-schema.json JSON schema>+-- to see how this works.+instance FromJSON PAT where+ parseJSON (Object v) = PhraseAlmostTree+ <$> v .: "phrase"+ <*> v .: "score"+ <*> v .: "forest"+ parseJSON _ = fail "Object not a PhraseAlmostTree."++-- |Convert a 'PAT' into a 'PhraseTree'.+fromPAT :: PAT -> PhraseTree+fromPAT (PhraseAlmostTree p s f) = Node (Phrase p s) $ map fromPAT f++-- |I figure some people like to type a lot.+fromPhraseAlmostTree :: PAT -> PhraseTree+fromPhraseAlmostTree = fromPAT++-- |Read a 'Phraselist', marshal it into a 'PhraseForest'.+readPhraselist :: Phraselist t => t -> IO PhraseForest+readPhraselist elist = do+ lpath <- phraselistPath elist+ ltext <- B.readFile lpath+ let ljson = (eitherDecode ltext) :: Either String [PAT]+ case ljson of+ Left msg -> fail msg+ Right pats -> return $ map fromPAT pats++-- |Alias for 'readPhraselist'+loadPhraselist :: Phraselist t => t -> IO PhraseForest+loadPhraselist = readPhraselist++-- |Alias for 'readPhraselist'+readPhraseFile :: Phraselist t => t -> IO PhraseForest+readPhraseFile = readPhraselist++-- |Alias for 'readPhraselist'+loadPhraseFile :: Phraselist t => t -> IO PhraseForest+loadPhraseFile = readPhraselist++-- |Alias for 'readPhraselist'+readPhraseForest :: Phraselist t => t -> IO PhraseForest+readPhraseForest = readPhraselist++-- |Alias for 'readPhraselist'+loadPhraseForest :: Phraselist t => t -> IO PhraseForest+loadPhraseForest = readPhraselist++-- |Load a 'Phraselist' directly into a 'PhraseMap'+readPhraseMap :: Phraselist t => t -> IO PhraseMap+readPhraseMap plist = fmap mkMap $ readPhraselist plist++-- |Alias for 'readPhraseMap'+loadPhraseMap :: Phraselist t => t -> IO PhraseMap+loadPhraseMap = readPhraseMap
− src/client/Erosc/Processor.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}---- |This is the module which actually processes the marshals the--- data. As far as erosc goes, this is the meat & potatoes.--- --- Basically, Main.hs was getting to be too long, so I created this--- file.--- --- Copyright (c) 2014, Peter Harpending <pharpend2@gmail.com>. All--- Rights Reserved.--- --- I'm supposed to say "All Rights Reserved," but this is actuallly--- BSD-licensed. So, really you can do whatever you want with--- this. Have fun!--module Erosc.Processor where---- One of these days, I'm going to figure out how to cut down on these--- imports. -import Control.Applicative-import Control.Monad (mzero)-import Data.Aeson hiding (encode)-import Data.Aeson.Encode.Pretty-import qualified Data.ByteString.Lazy as LzByte-import qualified Data.Text.Lazy as LzText-import Text.Eros---- |Okay, here's a function that actually does something. It takes an--- 'Input' type, and process it.-processInput :: Input -> IO Output-processInput (Input txt lists) = do- outLists <- mapM listPair lists- return $ Output outLists- where- listPair :: ErosList -> IO (ErosList, Score)- listPair ls = do- pmap <- loadPhraseMap ls- let scr = messageScore txt pmap- return (ls, scr)---- |This will print JSON in a pretty matter, using 2-space indents. I--- have no idea why 4-space indents are the default.-encode :: ToJSON a => a -> LzByte.ByteString-encode = encodePretty' defConfig { confIndent = 2- }---- |We represent the input data in its own data type. This is needed--- for JSON parsing, but it will also be useful down the road, when I--- allow input that isn't JSON.-data Input = Input { text :: LzText.Text- , erosLists :: [ErosList]- }---- |This is pretty self-explanatory-instance FromJSON ErosList where- parseJSON (String s) = case erosListByName (LzText.fromStrict s) of- Just list -> return list- Nothing -> mzero- parseJSON _ = mzero---- |This is pretty self-explanatory-instance FromJSON Input where- parseJSON (Object v) = Input- <$> v .: "text"- <*> v .: "eros-lists"- parseJSON _ = mzero---- |This is the output data type. I will make an instance of ToJSON--- for this data type. Again, at the start, only JSON input and output--- is existent.-data Output = Output { elScore :: [(ErosList, Score)] }---- |Pretty self-explanatory-instance ToJSON ErosList where- toJSON el = case erosNameByList el of- Just nom -> toJSON nom- Nothing -> "There's probably a bug in the JSON parsing \- \library Eros uses. You should file a bug \- \report at https://github.com/pharpend/eros/issues."---- |Pretty self-explanatory-instance ToJSON (ErosList, Score) where- toJSON (el, sc) = object [ "eros-list" .= el- , "score" .= sc- ]---- |Pretty self-explanatory-instance ToJSON Output where- toJSON (Output elm) = toJSON elm---- |It's convenient to think of Scores as Scores, although, they are--- truly ints.-type Score = Int
− src/client/Main.lhs
@@ -1,78 +0,0 @@-|This is the main module for the eros client. This is not the meat &-potatoes of the program, but this is the bread & butter.--> module Main where---So, here are our imports. I would like to only have IO inputs, however-the import of 'Data.Aeson' is needed in order to keep the-'Erosc.Processor' module pure.--Essentially, I was faced with either making this module be tainted by-purity, or have the other module be pure.--My qualified imports are a bit obnoxious. Even though they aren't-needed, I find that using qualified names makes the code a bit less-confusing. That is, @LzByte.hGetContents@ is a lot more informative-than just @hGetContents@.--> import Data.Aeson as Aeson-> import qualified Data.ByteString.Lazy as LzByte-> import Erosc.Processor as Erosc-> import qualified System.IO as StdIO---|Eventually, I'll need this data type when I use command line-arguments. For the moment, it's just a dummy type. So, enjoy it.--> data EroscOpts = EroscOpts--|So, this is the main function. Whoop de doo. It sends the contents-of 'StdIO.stdin' to runBtStr.--Eventually, I'll add in command line argument parsing, and then we'll-have a use for the 'EroscOptions' type.--> main :: IO ()-> main = runBtStr =<< LzByte.hGetContents StdIO.stdin--|This function takes the input (presumably 'StdIO.stdin'), and tries-to decode it.--If it successfully decodes the input into the 'Erosc.Input' type,-it sends the newfound decoded input to 'runInput', which sends it to-the processor.--If it can't, the program will throw a tantrum and shit itself.--> runBtStr :: LzByte.ByteString -> IO ()-> runBtStr inputBt = do-> let eitherJson = (Aeson.eitherDecode inputBt) :: Either String Erosc.Input-> case eitherJson of-> Left msg -> fail msg-> Right ecInput -> runInput ecInput---There is an astonishing quantity of bureaucracy in this program. You-have to go through like 5 functions before you get to a function that-actually does something useful.--|Okay, so, we're getting closer to the part of the program that-actually does stuff (or further away, depending on the location from-whence you come).--'runInput' takes the 'Erosc.Input' object (I do hate that word), and-sends it to some function in 'Erosc' that actually mutates the-data. Well, it doesn't mutate it, obviously, because this is Haskell,-but you get the idea.--@result@ needs to be '(<-)'d because 'Erosc.processInput' needs to-read the phraselist JSON file. This is a result of poor library design-on my part. I will fix this in a future release.--> runInput :: Erosc.Input -> IO ()-> runInput ipt = do-> result <- Erosc.processInput ipt-> let jsonText = Erosc.encode result-> LzByte.hPutStr StdIO.stdout jsonText-
− src/library/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/library/Text/Eros/Message.hs
@@ -1,61 +0,0 @@--- |--- 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'.--module Text.Eros.Message (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
− src/library/Text/Eros/Phrase.hs
@@ -1,57 +0,0 @@--- |--- Module : Text.Eros.Phrase--- Description : Pure interface for 'Phrase's and 'PhraseTree's.--- Copyright : 2014, Peter Harpending.--- License : BSD3--- Maintainer : Peter Harpending <pharpend2@gmail.com>--- Stability : experimental--- Portability : archlinux--- --module Text.Eros.Phrase where--import qualified Data.Map as M-import Data.Ord (comparing)-import Data.Text.Lazy (Text)-import Data.Tree---- |A Phrase is a piece of Text, with an int representing its--- weight. These are the used internally within 'eros', in--- 'Tree's. -data Phrase = Phrase { phrase :: Text- , score :: Int- }- deriving (Read, Show)--instance Eq Phrase where- a == b = (score a) == (score b)- a /= b = (score a) /= (score b)--instance Ord Phrase where- -- |To compare 'Phrases', just compare their 'score's- compare = comparing score---- |A 'Tree' of 'Phrase's-type PhraseTree = Tree Phrase--- |A 'Forest' of 'Phrase's-type PhraseForest = Forest Phrase--- |A Map of text values the appropriate tree-type PhraseMap = M.Map Text PhraseTree---- |The 'score' of the 'PhraseTree' is the sum of the 'score's of its 'Node's.-treeScore :: PhraseTree -> Int-treeScore = sum . map score . flatten---- |Given a list of 'PhraseTree's, return the top-level 'phrase's.-forestPhrases :: [PhraseTree] -> [Text]-forestPhrases = map forestPhrase---- |Given a 'PhraseTree', return the top-level 'phrase'.-forestPhrase :: PhraseTree -> Text-forestPhrase (Node phr subf) = phrase phr---- |Given a list of 'PhraseTree's, return a map of each phrase with--- the appropriate tree.-mkMap :: PhraseForest -> PhraseMap-mkMap = M.fromList . phraseTreeAlist- where phraseTreeAlist frs = zip (forestPhrases frs) frs
− src/library/Text/Eros/Phraselist.hs
@@ -1,330 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module : Text.Eros.Phraselist--- Description : A module for dealing with Phraselists.--- Copyright : 2014, Peter Harpending.--- License : BSD3--- Maintainer : Peter Harpending <pharpend2@gmail.com>--- Stability : experimental--- Portability : archlinux------ If you want to make your own phraselist, you need to write a JSON--- file, in accordance with the--- <https://raw.githubusercontent.com/pharpend/eros/master/res/phraselist-schema.json schema>.--- Once you do that, make a data type for your phraselist.--- Make your data type an instance of 'Phraselist', and you're good to--- go.--- --- For example, let's say your phraselist is @mylist.json@, and it's--- all in accordance with the schema. Your code would look something--- like this:--- --- @--- data MyList = MyList--- --- instance Phraselist MyList where--- phraselistPath MyList = getDataFileName "mylist.json"--- phraselistPath _ = undefined--- @--- --- Don't forget to add @mylist.json@ to @Data-Files@ in your @.cabal@--- file.--- --- If you want to use one of the lists we already supply--- --module Text.Eros.Phraselist where--import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero, sequence)-import Data.Aeson-import qualified Data.ByteString.Lazy as B-import qualified Data.Map as M-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as L-import Data.Tree-import Paths_eros-import System.Exit-import Text.Eros.Phrase--class Phraselist t where- phraselistPath :: t -> IO FilePath---- |A set of 'Phraselist's. Note that this is actually a list, and I'm--- calling it a "set" for purely lexical purposes.-type PhraselistSet = Phraselist t => [t]---- |The phraselists in @res/@. Each of these constructors correspond--- to one of the files--- <https://github.com/pharpend/eros/tree/master/res/phraselists-pretty here>.--- --- Gitlab has a terrible interface, so I won't provide links to each--- one of them.-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--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---- |A list of phraselists we provide.-erosLists :: [ErosList]-erosLists = [ 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- ]---- |A list of the paths to the phraselists we provide.-erosListPaths :: IO [FilePath]-erosListPaths = mapM phraselistPath erosLists--erosListNames :: [L.Text]-erosListNames = [ "chat"- , "conspiracy"- , "drug-advocacy"- , "forums"- , "gambling"- , "games"- , "gore"- , "id-theft"- , "illegal-drugs"- , "intolerance"- , "legal-drugs"- , "malware"- , "music"- , "news"- , "nudism"- , "peer2peer"- , "personals"- , "pornography"- , "proxies"- , "secret-societies"- , "self-labeling"- , "sport"- , "translation"- , "upstream-filter"- , "violence"- , "warez-hacking"- , "weapons"- , "webmail"- ]---- |You can't really order the lists, so we won't use 'M.Map'-erosListNamePairs :: [(ErosList, L.Text)]-erosListNamePairs = zip erosLists erosListNames--erosNameByList :: ErosList -> Maybe L.Text-erosNameByList key = lookup key erosListNamePairs--erosNameListMap :: M.Map L.Text ErosList-erosNameListMap = M.fromList $ zip erosListNames erosLists--erosListByName :: L.Text -> Maybe ErosList-erosListByName key = M.lookup key erosNameListMap ---- These are the data paths for the various PhraseLists-instance Phraselist ErosList where- phraselistPath Chat = getDataFileName "res/phraselists-ugly/chat.json"- phraselistPath Conspiracy = getDataFileName "res/phraselists-ugly/conspiracy.json"- phraselistPath DrugAdvocacy = getDataFileName "res/phraselists-ugly/drug-advocacy.json"- phraselistPath Forums = getDataFileName "res/phraselists-ugly/forums.json"- phraselistPath Gambling = getDataFileName "res/phraselists-ugly/gambling.json"- phraselistPath Games = getDataFileName "res/phraselists-ugly/games.json"- phraselistPath Gore = getDataFileName "res/phraselists-ugly/gore.json"- phraselistPath IdTheft = getDataFileName "res/phraselists-ugly/id-theft.json"- phraselistPath IllegalDrugs = getDataFileName "res/phraselists-ugly/illegal-drugs.json"- phraselistPath Intolerance = getDataFileName "res/phraselists-ugly/intolerance.json"- phraselistPath LegalDrugs = getDataFileName "res/phraselists-ugly/legal-drugs.json"- phraselistPath Malware = getDataFileName "res/phraselists-ugly/malware.json"- phraselistPath Music = getDataFileName "res/phraselists-ugly/music.json"- phraselistPath News = getDataFileName "res/phraselists-ugly/news.json"- phraselistPath Nudism = getDataFileName "res/phraselists-ugly/nudism.json"- phraselistPath Peer2Peer = getDataFileName "res/phraselists-ugly/peer2peer.json"- phraselistPath Personals = getDataFileName "res/phraselists-ugly/personals.json"- phraselistPath Pornography = getDataFileName "res/phraselists-ugly/pornography.json"- phraselistPath Proxies = getDataFileName "res/phraselists-ugly/proxies.json"- phraselistPath SecretSocieties = getDataFileName "res/phraselists-ugly/secret-societies.json"- phraselistPath SelfLabeling = getDataFileName "res/phraselists-ugly/self-labeling.json"- phraselistPath Sport = getDataFileName "res/phraselists-ugly/sport.json"- phraselistPath Translation = getDataFileName "res/phraselists-ugly/translation.json"- phraselistPath UpstreamFilter = getDataFileName "res/phraselists-ugly/upstream-filter.json"- phraselistPath Violence = getDataFileName "res/phraselists-ugly/violence.json"- phraselistPath WarezHacking = getDataFileName "res/phraselists-ugly/warez-hacking.json"- phraselistPath Weapons = getDataFileName "res/phraselists-ugly/weapons.json"- phraselistPath Webmail = getDataFileName "res/phraselists-ugly/webmail.json"---- |Placeholder type used to read JSON. The JSON schema (currently, at--- least) is such that one needs this type to read the JSON. You can--- use 'fromPAT' to convert this type into a 'PhraseTree'-data PhraseAlmostTree = PhraseAlmostTree { patPhrase :: Text- , patScore :: Int- , patForest :: [PhraseAlmostTree]- }- deriving (Show, Read)---- |Alias for 'PhraseAlmostTree'-type PAT = PhraseAlmostTree---- |You can read the--- <https://raw.githubusercontent.com/pharpend/eros/master/res/phraselist-schema.json JSON schema>--- to see how this works.-instance FromJSON PAT where- parseJSON (Object v) = PhraseAlmostTree- <$> v .: "phrase"- <*> v .: "score"- <*> v .: "forest"- parseJSON _ = fail "Object not a PhraseAlmostTree."---- |Convert a 'PAT' into a 'PhraseTree'.-fromPAT :: PAT -> PhraseTree-fromPAT (PhraseAlmostTree p s f) = Node (Phrase p s) $ map fromPAT f---- |I figure some people like to type a lot.-fromPhraseAlmostTree :: PAT -> PhraseTree-fromPhraseAlmostTree = fromPAT---- |Read a 'Phraselist', marshal it into a 'PhraseForest'.-readPhraselist :: Phraselist t => t -> IO PhraseForest-readPhraselist elist = do- lpath <- phraselistPath elist- ltext <- B.readFile lpath- let ljson = (eitherDecode ltext) :: Either String [PAT]- case ljson of- Left msg -> fail msg- Right pats -> return $ map fromPAT pats---- |Alias for 'readPhraselist'-loadPhraselist :: Phraselist t => t -> IO PhraseForest-loadPhraselist = readPhraselist---- |Alias for 'readPhraselist'-readPhraseFile :: Phraselist t => t -> IO PhraseForest-readPhraseFile = readPhraselist---- |Alias for 'readPhraselist'-loadPhraseFile :: Phraselist t => t -> IO PhraseForest-loadPhraseFile = readPhraselist---- |Alias for 'readPhraselist'-readPhraseForest :: Phraselist t => t -> IO PhraseForest-readPhraseForest = readPhraselist---- |Alias for 'readPhraselist'-loadPhraseForest :: Phraselist t => t -> IO PhraseForest-loadPhraseForest = readPhraselist---- |Load a 'Phraselist' directly into a 'PhraseMap'-readPhraseMap :: Phraselist t => t -> IO PhraseMap-readPhraseMap plist = fmap mkMap $ readPhraselist plist---- |Alias for 'readPhraseMap'-loadPhraseMap :: Phraselist t => t -> IO PhraseMap-loadPhraseMap = readPhraseMap
− test/Main.hs
@@ -1,14 +0,0 @@-module Main where--import Control.Applicative-import qualified Data.Text.Lazy as T-import Test.QuickCheck-import TextErosPhrase--instance Arbitrary T.Text where- arbitrary = T.pack <$> arbitrary- shrink xs = T.pack <$> shrink (T.unpack xs)--main :: IO ()-main = do- quickCheck ordPhraseForest
− test/TextErosPhrase.hs
@@ -1,22 +0,0 @@--- |Some tests for the Text.Eros.Phrase module-module TextErosPhrase where--import Data.List-import qualified Data.Map.Strict as M-import qualified Data.Text.Lazy as T-import Data.Tree-import Test.QuickCheck-import Text.Eros.Phrase---- |Given Text Int pairs, make some phrases-mkPhrases :: [(T.Text, Int)] -> [Phrase]-mkPhrases [] = []-mkPhrases ((s, i):x) = psi:px- where psi = Phrase s i- px = mkPhrases x---- |Try to order the phrases-ordPhraseForest :: [(T.Text, Int)] -> Bool-ordPhraseForest ti = phraseOrd == scoreOrd- where scoreOrd = sort $ map snd ti- phraseOrd = map score $ sort $ mkPhrases ti