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
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
readPhraseMap :: Phraselist t => t -> IO PhraseMap
readPhraseMap plist = mkMap <$> readPhraselist plist
servePhraselist :: Phraselist t => t -> IO B.ByteString
servePhraselist plist = B.readFile =<< phraselistPath plist
class Phraselist t where
phraselistPath :: t -> IO FilePath
type PhraselistSet = Phraselist t => [t]
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)
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
]
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"
]
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
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"
data PhraseAlmostTree = PhraseAlmostTree { patPhrase :: Text
, patScore :: Int
, patForest :: [PhraseAlmostTree]
}
deriving (Show, Read)
type PAT = PhraseAlmostTree
instance FromJSON PAT where
parseJSON (Object v) = PhraseAlmostTree
<$> v .: "phrase"
<*> v .: "score"
<*> v .: "forest"
parseJSON _ = fail "Object not a PhraseAlmostTree."
fromPAT :: PAT -> PhraseTree
fromPAT (PhraseAlmostTree p s f) = Node (Phrase p s) $ map fromPAT f
fromPhraseAlmostTree :: PAT -> PhraseTree
fromPhraseAlmostTree = fromPAT
loadPhraselist :: Phraselist t => t -> IO PhraseForest
loadPhraselist = readPhraselist
readPhraseFile :: Phraselist t => t -> IO PhraseForest
readPhraseFile = readPhraselist
loadPhraseFile :: Phraselist t => t -> IO PhraseForest
loadPhraseFile = readPhraselist
readPhraseForest :: Phraselist t => t -> IO PhraseForest
readPhraseForest = readPhraselist
loadPhraseForest :: Phraselist t => t -> IO PhraseForest
loadPhraseForest = readPhraselist
loadPhraseMap :: Phraselist t => t -> IO PhraseMap
loadPhraseMap = readPhraseMap