-- (c) Josef Svenningsson, 2005
-- Licence: No licence, public domain

-- Inspired by the following page:
-- http://www.microsoft.com/athome/security/children/kidtalk.mspx
module Lambdabot.Plugin.Novelty.Elite (elitePlugin) where

import Lambdabot.Plugin
import Lambdabot.Util

import Control.Arrow
import Control.Monad
import Data.Char
import Data.Maybe
import Text.Regex.TDFA

elitePlugin :: Module ()
elitePlugin :: Module ()
elitePlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"elite")
            { aliases :: [String]
aliases = [String
"leet", String
"l33t", String
"1337"]
            , help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"elite <phrase>. Translate English to elitespeak"
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
args -> case String -> [String]
words String
args of
                 [] -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Say again?"
                 [String]
wds -> do let instr :: String
instr = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([String] -> String
unwords [String]
wds)
                           String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT () LB) ())
-> Cmd (ModuleT () LB) String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> Cmd (ModuleT () LB) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO String
translateLine String
instr)
            }
        ]
    }

translateLine :: String -> IO String
translateLine :: String -> IO String
translateLine = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
translate (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:)
-- extra space allows whole-word patterns to match at start

translate :: String -> IO String
translate :: String -> IO String
translate []  = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return []
translate String
str = do
    let alts :: [(String, String)]
alts = [ (String -> String
subst String
match',String
rest)
               | (Regex
re, String -> String
subst) <- [(Regex, String -> String)]
ruleList
               , MatchResult String
mr <- Maybe (MatchResult String) -> [MatchResult String]
forall a. Maybe a -> [a]
maybeToList (Regex -> String -> Maybe (MatchResult String)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
str)
               , String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MatchResult String -> String
forall a. MatchResult a -> a
mrBefore MatchResult String
mr)
               , let match' :: String
match' = MatchResult String -> String
forall a. MatchResult a -> a
mrMatch MatchResult String
mr
                     rest :: String
rest   = MatchResult String -> String
forall a. MatchResult a -> a
mrAfter MatchResult String
mr
               ]
    (String
subst,String
rest) <- [(String, String)] -> IO (String, String)
forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [(String, String)]
alts
    (String -> String) -> IO String -> IO String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String
subst String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> IO String
translate String
rest)

ruleList :: [(Regex, String -> String)]
ruleList :: [(Regex, String -> String)]
ruleList = ((String, String -> String) -> (Regex, String -> String))
-> [(String, String -> String)] -> [(Regex, String -> String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Regex)
-> (String, String -> String) -> (Regex, String -> String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex)
    [ (String
".",     String -> String
forall a. a -> a
id            )
    , (String
".",     (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper   )
    , (String
"a",     String -> String -> String
forall a b. a -> b -> a
const String
"4"     )
    , (String
"b",     String -> String -> String
forall a b. a -> b -> a
const String
"8"     )
    , (String
" be ",  String -> String -> String
forall a b. a -> b -> a
const String
" b "   )
    , (String
"c",     String -> String -> String
forall a b. a -> b -> a
const String
"("     )
    , (String
"ck",    String -> String -> String
forall a b. a -> b -> a
const String
"xx"    )
    , (String
"cks ",  String -> String -> String
forall a b. a -> b -> a
const String
"x "    )
    , (String
"cks ",  String -> String -> String
forall a b. a -> b -> a
const String
"x0rs " )
    , (String
"cks ",  String -> String -> String
forall a b. a -> b -> a
const String
"x0rz " )
    , (String
" cool ",String -> String -> String
forall a b. a -> b -> a
const String
" kewl ")
    , (String
"e",     String -> String -> String
forall a b. a -> b -> a
const String
"3"     )
    , (String
"elite", String -> String -> String
forall a b. a -> b -> a
const String
"1337"  )
    , (String
"elite", String -> String -> String
forall a b. a -> b -> a
const String
"leet"  )
    , (String
"f",     String -> String -> String
forall a b. a -> b -> a
const String
"ph"    )
    , (String
" for ", String -> String -> String
forall a b. a -> b -> a
const String
" 4 "   )
    , (String
"g",     String -> String -> String
forall a b. a -> b -> a
const String
"9"     )
    , (String
"h",     String -> String -> String
forall a b. a -> b -> a
const String
"|-|"   )
    , (String
"k",     String -> String -> String
forall a b. a -> b -> a
const String
"x"     )
    , (String
"l",     String -> String -> String
forall a b. a -> b -> a
const String
"|"     )
    , (String
"l",     String -> String -> String
forall a b. a -> b -> a
const String
"1"     )
    , (String
"m",     String -> String -> String
forall a b. a -> b -> a
const String
"/\\/\\")
    , (String
"o",     String -> String -> String
forall a b. a -> b -> a
const String
"0"     )
    , (String
"ph",    String -> String -> String
forall a b. a -> b -> a
const String
"f"     )
    , (String
"s",     String -> String -> String
forall a b. a -> b -> a
const String
"z"     )
    , (String
"s",     String -> String -> String
forall a b. a -> b -> a
const String
"$"     )
    , (String
"s",     String -> String -> String
forall a b. a -> b -> a
const String
"5"     )
    , (String
"s ",    String -> String -> String
forall a b. a -> b -> a
const String
"z0rz " )
    , (String
"t",     String -> String -> String
forall a b. a -> b -> a
const String
"7"     )
    , (String
"t",     String -> String -> String
forall a b. a -> b -> a
const String
"+"     )
    , (String
" the ", String -> String -> String
forall a b. a -> b -> a
const String
" teh " )
    , (String
" to ",  String -> String -> String
forall a b. a -> b -> a
const String
" 2 "   )
    , (String
" to ",  String -> String -> String
forall a b. a -> b -> a
const String
" too " )
    , (String
" to ",  String -> String -> String
forall a b. a -> b -> a
const String
" tu "  )
    , (String
" too ", String -> String -> String
forall a b. a -> b -> a
const String
" to "  )
    , (String
"v",     String -> String -> String
forall a b. a -> b -> a
const String
"\\/"   )
    , (String
"w",     String -> String -> String
forall a b. a -> b -> a
const String
"\\/\\/")
    , (String
" you ", String -> String -> String
forall a b. a -> b -> a
const String
" u "   )
    , (String
" you ", String -> String -> String
forall a b. a -> b -> a
const String
" yu "  )
    , (String
" you ", String -> String -> String
forall a b. a -> b -> a
const String
" joo " )
    , (String
"z",     String -> String -> String
forall a b. a -> b -> a
const String
"s"     )
    ]