lambdabot-novelty-plugins (empty) → 5.0
raw patch · 15 files changed
+867/−0 lines, 15 filesdep +basedep +binarydep +brainfucksetup-changed
Dependencies added: base, binary, brainfuck, bytestring, containers, dice, directory, lambdabot-core, misfortune, process, random-fu, regex-tdfa, unlambda
Files
- LICENSE +22/−0
- Setup.hs +3/−0
- lambdabot-novelty-plugins.cabal +70/−0
- src/Lambdabot/Config/Novelty.hs +13/−0
- src/Lambdabot/Plugin/Novelty.hs +29/−0
- src/Lambdabot/Plugin/Novelty/BF.hs +39/−0
- src/Lambdabot/Plugin/Novelty/Dice.hs +39/−0
- src/Lambdabot/Plugin/Novelty/Elite.hs +93/−0
- src/Lambdabot/Plugin/Novelty/Filter.hs +69/−0
- src/Lambdabot/Plugin/Novelty/Numberwang.hs +68/−0
- src/Lambdabot/Plugin/Novelty/Quote.hs +195/−0
- src/Lambdabot/Plugin/Novelty/Slap.hs +79/−0
- src/Lambdabot/Plugin/Novelty/Unlambda.hs +32/−0
- src/Lambdabot/Plugin/Novelty/Vixen.hs +97/−0
- src/Lambdabot/Util/Process.hs +19/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2003 Andrew J. Bromage+Portions Copyright (c) 2003 Shae Erisson, Sven M. Hallberg, Taylor Campbell+Portions Copyright (c) 2003-2006 Members of the AUTHORS file++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject+to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY+KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ lambdabot-novelty-plugins.cabal view
@@ -0,0 +1,70 @@+name: lambdabot-novelty-plugins+version: 5.0++license: GPL+license-file: LICENSE++author: Don Stewart+maintainer: James Cook <mokus@deepbondi.net>++category: Development, Web+synopsis: Novelty plugins for Lambdabot+description: Lambdabot is an IRC bot written over several years by+ those on the #haskell IRC channel.+ .+ Provided plugins:+ .+ [bf] Run Brainf*ck code.+ [dice] Roll some dice.+ [elite] zPEak Gib8erI$|-|.+ [filter] More gibberish.+ [numberwang] Sorry, that's not Numberwang.+ [quote] Parrot profound wisdom.+ [slap] Delegate punishment.+ [unlambda] Run Unlambda code.+ [vixen] Let's chat, honey.++homepage: http://haskell.org/haskellwiki/Lambdabot++build-type: Simple+cabal-version: >= 1.8+tested-with: GHC == 7.6.3, GHC == 7.8.3++source-repository head+ type: git+ location: https://github.com/lambdabot/lambdabot.git++library+ hs-source-dirs: src+ ghc-options: -Wall+ -funbox-strict-fields++ exposed-modules: Lambdabot.Plugin.Novelty+ other-modules: Lambdabot.Config.Novelty+ Lambdabot.Plugin.Novelty.BF+ Lambdabot.Plugin.Novelty.Dice+ Lambdabot.Plugin.Novelty.Elite+ Lambdabot.Plugin.Novelty.Filter+ Lambdabot.Plugin.Novelty.Numberwang+ Lambdabot.Plugin.Novelty.Quote+ Lambdabot.Plugin.Novelty.Slap+ Lambdabot.Plugin.Novelty.Unlambda+ Lambdabot.Plugin.Novelty.Vixen++ other-modules: Lambdabot.Util.Process++ build-depends: base >= 4.4 && < 5,+ binary >= 0.5,+ bytestring >= 0.9,+ containers >= 0.4,+ dice >= 0.1,+ directory >= 1.1,+ lambdabot-core >= 5 && < 5.1,+ misfortune >= 0.1,+ process >= 1.1,+ random-fu >= 0.2,+ regex-tdfa >= 1.1,++ -- runtime dependencies+ brainfuck == 0.1,+ unlambda >= 0.1
+ src/Lambdabot/Config/Novelty.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}+module Lambdabot.Config.Novelty+ ( bfBinary+ , unlambdaBinary+ ) where++import Lambdabot.Config++config "bfBinary" [t| String |] [| "bf" |]+config "unlambdaBinary" [t| String |] [| "unlambda" |]
+ src/Lambdabot/Plugin/Novelty.hs view
@@ -0,0 +1,29 @@+module Lambdabot.Plugin.Novelty + ( bfPlugin+ , dicePlugin+ , elitePlugin+ , filterPlugin+ , numberwangPlugin+ , quotePlugin+ , slapPlugin+ , unlambdaPlugin+ , vixenPlugin+ + , noveltyPlugins+ + , module Lambdabot.Config.Novelty+ ) where++import Lambdabot.Config.Novelty+import Lambdabot.Plugin.Novelty.BF+import Lambdabot.Plugin.Novelty.Dice+import Lambdabot.Plugin.Novelty.Elite+import Lambdabot.Plugin.Novelty.Filter+import Lambdabot.Plugin.Novelty.Numberwang+import Lambdabot.Plugin.Novelty.Quote+import Lambdabot.Plugin.Novelty.Slap+import Lambdabot.Plugin.Novelty.Unlambda+import Lambdabot.Plugin.Novelty.Vixen++noveltyPlugins :: [String]+noveltyPlugins = ["bf", "dice", "elite", "filter", "numberwang", "quote", "slap", "unlambda", "vixen"]
+ src/Lambdabot/Plugin/Novelty/BF.hs view
@@ -0,0 +1,39 @@+-- Copyright (c) 2006 Jason Dagit - http://www.codersbase.com/+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)++-- | A plugin for the Haskell interpreter for the brainf*ck language+-- http://www.muppetlabs.com/~breadbox/bf/+module Lambdabot.Plugin.Novelty.BF (bfPlugin) where++import Lambdabot.Config.Novelty+import Lambdabot.Plugin+import Lambdabot.Util.Process++import Data.Char+import Text.Regex.TDFA++bfPlugin :: Module ()+bfPlugin = newModule+ { moduleCmds = return+ [ (command "bf")+ { help = say "bf <expr>. Evaluate a brainf*ck expression"+ , process = \msg -> do+ bf <- getConfig bfBinary+ ios80 (run bf msg scrub)+ }+ ]+ }++-- Clean up output+scrub :: String -> String+scrub = unlines . take 6 . map (' ':) . filter (not.null) . map cleanit . lines++cleanit :: String -> String+cleanit s | s =~ terminated = "Terminated\n"+ | otherwise = filter printable s+ where terminated = "waitForProc"+ -- the printable ascii chars are in the range [32 .. 126]+ -- according to wikipedia:+ -- http://en.wikipedia.org/wiki/ASCII#ASCII_printable_characters+ printable x = 31 < ord x && ord x < 127+
+ src/Lambdabot/Plugin/Novelty/Dice.hs view
@@ -0,0 +1,39 @@+-- | This module is for throwing dice for e.g. RPGs. (\@dice 3d6+2)++-- Original version copyright Einar Karttunen <ekarttun@cs.helsinki.fi> 2005-04-06.+-- Massive rewrite circa 2008-10-20 copyright James Cook <mokus@deepbondi.net>+module Lambdabot.Plugin.Novelty.Dice (dicePlugin) where++import Lambdabot.Plugin+import Lambdabot.Util++import Data.List+import Data.Random.Dice (rollEm)++type Dice = ModuleT () LB++dicePlugin :: Module ()+dicePlugin = newModule+ { moduleCmds = return+ [ (command "dice")+ { aliases = ["roll"]+ , help = say "@dice <expr>. Throw random dice. <expr> is of the form 3d6+2."+ , process = doDice True+ }+ ]+ , contextual = doDice False+ }++doDice :: Bool -> String -> Cmd Dice ()+doDice printErrs text = do+ user <- showNick =<< getSender+ result <- io (rollEm text)+ case result of+ Left err -> if printErrs+ then say (trimError err)+ else return ()+ Right str -> + say (limitStr 75 (user ++ ": " ++ str))+ + where+ trimError = concat . intersperse ": " . tail . lines . show
+ src/Lambdabot/Plugin/Novelty/Elite.hs view
@@ -0,0 +1,93 @@+-- (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 = newModule+ { moduleCmds = return+ [ (command "elite")+ { aliases = ["leet", "l33t", "1337"]+ , help = say "elite <phrase>. Translate English to elitespeak"+ , process = \args -> case words args of+ [] -> say "Say again?"+ wds -> do let instr = map toLower (unwords wds)+ say =<< io (translateLine instr)+ + }+ ]+ }++translateLine :: String -> IO String+translateLine = fmap (dropWhile isSpace) . translate . (' ':)+-- extra space allows whole-word patterns to match at start++translate :: String -> IO String+translate [] = return []+translate str = do+ let alts = [ (subst match',rest)+ | (re, subst) <- ruleList+ , mr <- maybeToList (matchM re str)+ , null (mrBefore mr)+ , let match' = mrMatch mr+ rest = mrAfter mr+ ]+ (subst,rest) <- random alts+ liftM (subst ++) (translate rest)++ruleList :: [(Regex, String -> String)]+ruleList = map (first makeRegex)+ [ (".", id )+ , (".", map toUpper )+ , ("a", const "4" )+ , ("b", const "8" )+ , (" be ", const " b " )+ , ("c", const "(" )+ , ("ck", const "xx" )+ , ("cks ", const "x " )+ , ("cks ", const "x0rs " )+ , ("cks ", const "x0rz " )+ , (" cool ",const " kewl ")+ , ("e", const "3" )+ , ("elite", const "1337" )+ , ("elite", const "leet" )+ , ("f", const "ph" )+ , (" for ", const " 4 " )+ , ("g", const "9" )+ , ("h", const "|-|" )+ , ("k", const "x" )+ , ("l", const "|" )+ , ("l", const "1" )+ , ("m", const "/\\/\\")+ , ("o", const "0" )+ , ("ph", const "f" )+ , ("s", const "z" )+ , ("s", const "$" )+ , ("s", const "5" )+ , ("s ", const "z0rz " )+ , ("t", const "7" )+ , ("t", const "+" )+ , (" the ", const " teh " )+ , (" to ", const " 2 " )+ , (" to ", const " too " )+ , (" to ", const " tu " )+ , (" too ", const " to " )+ , ("v", const "\\/" )+ , ("w", const "\\/\\/")+ , (" you ", const " u " )+ , (" you ", const " yu " )+ , (" you ", const " joo " )+ , ("z", const "s" )+ ]+
+ src/Lambdabot/Plugin/Novelty/Filter.hs view
@@ -0,0 +1,69 @@+-- | GNU Talk Filters+-- needs: http://www.hyperrealm.com/main.php?s=talkfilters+-- Edward Kmett 2006++module Lambdabot.Plugin.Novelty.Filter (filterPlugin) where++import Lambdabot.Plugin+import Lambdabot.Util++import Control.Applicative+import Data.Maybe+import System.Directory (findExecutable)+import System.Process++-- State consists of a map from filter name to executable path++filterPlugin :: Module [(String, FilePath, String)]+filterPlugin = newModule+ { moduleDefState = catMaybes <$> sequence+ [ do+ mbPath <- io (findExecutable name)+ return $! do+ path <- mbPath+ Just (name, path, descr)+ | (name, descr) <- filters+ ]+ + , moduleCmds = do+ activeFilters <- readMS+ return+ [ (command name)+ { help = say descr+ , process = \s -> do+ case words s of+ [] -> say ("usage: " ++ name ++ " <phrase>")+ t -> ios80 (runFilter path (unwords t))+ }+ | (name, path, descr) <- activeFilters+ ]+ }++filters :: [(String, String)]+filters =+ [ ("austro", "austro <phrase>. Talk like Ahhhnold")+ , ("b1ff", "b1ff <phrase>. B1ff of usenet yore")+ , ("brooklyn", "brooklyn <phrase>. Yo")+ , ("chef", "chef <phrase>. Bork bork bork")+ , ("cockney", "cockney <phrase>. Londoner accent")+ , ("drawl", "drawl <phrase>. Southern drawl")+ , ("dubya", "dubya <phrase>. Presidential filter")+ , ("fudd", "fudd <phrase>. Fudd, Elmer")+ , ("funetak", "funetak <phrase>. Southern drawl")+ , ("jethro", "jethro <phrase>. Now listen to a story 'bout a man named Jed...")+ , ("jive", "jive <phrase>. Slap ma fro")+ , ("kraut", "kraut <phrase>. German accent")+ , ("pansy", "pansy <phrase>. Effeminate male")+ , ("pirate", "pirate <phrase>. Talk like a pirate")+ , ("postmodern", "postmodern <phrase>. Feminazi")+ , ("redneck", "redneck <phrase>. Deep south")+ , ("valspeak", "valley <phrase>. Like, ya know?")+ , ("warez", "warez <phrase>. H4x0r")+ ]++runFilter :: String -> String -> IO String+runFilter f s = do+ out <- readProcess f [] s+ return $ result out+ where result [] = "Couldn't run the filter."+ result xs = unlines . filter (not . all (==' ')) . lines $ xs
+ src/Lambdabot/Plugin/Novelty/Numberwang.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE TypeFamilies #-}++module Lambdabot.Plugin.Novelty.Numberwang (numberwangPlugin) where++import Control.Applicative+import Control.Monad+import Data.Random+import Data.Random.Distribution.Poisson+import Lambdabot.Plugin+import Numeric+++data NumberwangState = State+ { nextCmd :: !Int -- number of invocations of @numberwang before the next numberwang+ , nextCon :: !Int -- number of contextual occurrences of numbers before next numberwang+ }++cmdDist :: RVar Int+cmdDist = poisson (3.5 :: Double)++conDist :: RVar Int+conDist = poisson (32 :: Double)++numberwangPlugin :: Module NumberwangState+numberwangPlugin = newModule+ { moduleDefState = sample (State <$> cmdDist <*> conDist)+ , moduleCmds = return+ [ (command "numberwang")+ { help = say "@numberwang <number>: Determines if it is Numberwang."+ , process = doNumberwang True . length . words+ }+ ]+ , contextual = doNumberwang False . length . (numbers :: String -> [Double])+ }++numbers :: RealFrac t => String -> [t]+numbers [] = []+numbers cs = case readFloat cs of+ (n, rest):_ -> n : numbers rest+ _ -> numbers (tail cs)++doNumberwang :: (Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>+ Bool -> a -> Cmd m ()+doNumberwang cmd n+ | n <= 0 = when cmd $ say "What number?"+ | otherwise = do+ isNumberwang <- checkNumberwang cmd 1+ if isNumberwang+ then say "That's Numberwang!"+ else when cmd $ say "Sorry, that's not Numberwang."++withState :: (MonadLBState m, LBState m ~ NumberwangState) =>+ Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a+withState True f = withMS $ \st setST ->+ f (nextCmd st) (\n -> setST st {nextCmd = n}) cmdDist+withState False f = withMS $ \st setST ->+ f (nextCon st) (\n -> setST st {nextCon = n}) conDist++checkNumberwang :: (MonadLBState m, LBState m ~ NumberwangState) =>+ Bool -> Int -> m Bool+checkNumberwang cmd l = withState cmd $ \ n setN nDist -> do+ if n <= l+ then do+ setN =<< lb (sample nDist)+ return True+ else do+ setN (n - l)+ return False
+ src/Lambdabot/Plugin/Novelty/Quote.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE FlexibleContexts #-}+-- | Support for quotes+module Lambdabot.Plugin.Novelty.Quote (quotePlugin) where++import Lambdabot.Plugin+import Lambdabot.Util++import qualified Data.ByteString.Char8 as P+import Data.Char+import Data.Fortune+import Data.List+import qualified Data.Map as M+import Data.Maybe+import Text.Regex.TDFA++type Key = P.ByteString+type Quotes = M.Map Key [P.ByteString]+type Quote = ModuleT Quotes LB++quotePlugin :: Module (M.Map P.ByteString [P.ByteString])+quotePlugin = newModule+ { moduleSerialize = Just mapListPackedSerial+ , moduleDefState = return M.empty+ , moduleInit = modifyMS (M.filter (not . null))++ , moduleCmds = return+ [ (command "quote")+ { help = say "quote <nick>: Quote <nick> or a random person if no nick is given"+ , process = runQuote . strip isSpace+ }+ , (command "remember")+ { help = say "remember <nick> <quote>: Remember that <nick> said <quote>."+ , process = runRemember . strip isSpace+ }+ , (command "forget")+ { help = say "forget nick quote. Delete a quote"+ , process = runForget . strip isSpace+ }+ , (command "ghc")+ { help = say "ghc. Choice quotes from GHC."+ , process = const (fortune ["ghc"])+ }+ , (command "fortune")+ { help = say "fortune. Provide a random fortune"+ , process = const (fortune [])+ }+ , (command "yow")+ { help = say "yow. The zippy man."+ , process = const (fortune ["zippy"])+ }+ , (command "arr")+ { help = say "arr. Talk to a pirate"+ , process = const (fortune ["arr"])+ }+ , (command "yarr")+ { help = say "yarr. Talk to a scurvy pirate"+ , process = const (fortune ["arr", "yarr"])+ }+ , (command "keal")+ { help = say "keal. Talk like Keal"+ , process = const (fortune ["keal"])+ }+ , (command "b52s")+ { help = say "b52s. Anyone noticed the b52s sound a lot like zippy?"+ , process = const (fortune ["b52s"])+ }+ , (command "pinky")+ { help = say "pinky. Pinky and the Brain"+ , process = \s -> fortune $ if "pondering" `isInfixOf` s+ then ["pinky-pondering"]+ else ["pinky-pondering", "pinky"]+ }+ , (command "brain")+ { help = say "brain. Pinky and the Brain"+ , process = const (fortune ["brain"])+ }+ , (command "palomer")+ { help = say "palomer. Sound a bit like palomer on a good day."+ , process = const (fortune ["palomer"])+ }+ , (command "girl19")+ { help = say "girl19 wonders what \"discriminating hackers\" are."+ , process = const (fortune ["girl19"])+ }+ , (command "v")+ { aliases = ["yhjulwwiefzojcbxybbruweejw"]+ , help = getCmdName >>= \v -> case v of+ "v" -> say "let v = show v in v"+ _ -> say "V RETURNS!"+ , process = const (fortune ["notoriousV"])+ }+ , (command "protontorpedo")+ { help = say "protontorpedo is silly"+ , process = const (fortune ["protontorpedo"])+ }+ , (command "nixon")+ { help = say "Richard Nixon's finest."+ , process = const (fortune ["nixon"])+ }+ , (command "farber")+ { help = say "Farberisms in the style of David Farber."+ , process = const (fortune ["farber"])+ }+ ]+ }++fortune :: [FilePath] -> Cmd Quote ()+fortune xs = io (resolveFortuneFiles All xs >>= randomFortune) >>= say++------------------------------------------------------------------------++-- the @remember command stores away a quotation by a user, for future+-- use by @quote++-- error handling!+runRemember :: String -> Cmd Quote ()+runRemember str+ | null rest = say "Incorrect arguments to quote"+ | otherwise = do+ withMS $ \fm writer -> do+ let ss = fromMaybe [] (M.lookup (P.pack nm) fm)+ fm' = M.insert (P.pack nm) (P.pack q : ss) fm+ writer fm'+ say =<< randomSuccessMsg+ where+ (nm,rest) = break isSpace str+ q = drop 1 rest++-- @forget, to remove a quote+runForget :: String -> Cmd Quote ()+runForget str+ | null rest = say "Incorrect arguments to quote"+ | otherwise = do+ ss <- withMS $ \fm writer -> do+ let ss = fromMaybe [] (M.lookup (P.pack nm) fm)+ fm' = case delete (P.pack q) ss of+ [] -> M.delete (P.pack nm) fm+ ss' -> M.insert (P.pack nm) ss' fm+ writer fm'+ return ss+ say $ if P.pack q `elem` ss+ then "Done."+ else "No match."+ where+ (nm,rest) = break isSpace str+ q = drop 1 rest++--+-- the @quote command, takes a user nm to choose a random quote from+--+runQuote :: String -> Cmd Quote ()+runQuote str =+ say =<< search (P.pack nm) (P.pack pat) =<< readMS+ where (nm, p) = break isSpace str+ pat = drop 1 p++search :: Key -> P.ByteString -> Quotes -> Cmd Quote String+search key pat db+ | M.null db = return "No quotes yet."++ | P.null key = do+ (key', qs) <- random (M.toList db) -- quote a random person+ fmap (display key') (random qs)++ | P.null pat, Just qs <- mquotes =+ fmap (display key) (random qs)++ | P.null pat = match' key allquotes++ | Just qs <- mquotes = match' pat (zip (repeat key) qs)++ | otherwise = do+ r <- randomFailureMsg+ return $ "No quotes for this person. " ++ r++ where+ mquotes = M.lookup key db+ allquotes = concat [ zip (repeat who) qs | (who, qs) <- M.assocs db ]++ match' p ss = do+ re <- makeRegexOptsM defaultCompOpt {caseSensitive = False, newSyntax = True}+ defaultExecOpt {captureGroups = False} p++ let rs = filter (match re . snd) ss+ if null rs+ then do r <- randomFailureMsg+ return $ "No quotes match. " ++ r+ else do (who, saying) <- random rs+ return $ P.unpack who ++ " says: " ++ P.unpack saying++ display k msg = (if P.null k then " " else who ++ " says: ") ++ saying+ where saying = P.unpack msg+ who = P.unpack k
+ src/Lambdabot/Plugin/Novelty/Slap.hs view
@@ -0,0 +1,79 @@+-- | Support for quotes+module Lambdabot.Plugin.Novelty.Slap (slapPlugin) where++import Lambdabot.Plugin+import Lambdabot.Util++type Slap = ModuleT () LB++slapPlugin :: Module ()+slapPlugin = newModule+ { moduleCmds = return+ [ (command "slap")+ { aliases = ["smack"]+ , help = say "slap <nick>. Slap someone amusingly."+ , process = slap+ }+ ]+ }++------------------------------------------------------------------------++slap :: String -> Cmd Slap ()+slap "me" = do+ target <- showNick =<< getSender+ slapRandom target+slap "yourself" = do+ target <- showNick =<< getLambdabotName+ slapRandom target+slap target =+ slapRandom target++slapRandom :: String -> Cmd Slap ()+slapRandom tgt = say . ($ tgt) =<< random slapList++slapList :: [String -> String]+slapList =+ [(\x -> "/me slaps " ++ x)+ ,(\x -> "/me smacks " ++ x ++ " about with a large trout")+ ,(\x -> "/me beats up " ++ x)+ ,(\x -> "/me pokes " ++ x ++ " in the eye")+ ,(\x -> "why on earth would I slap " ++ x ++ "?")+ ,(\x -> "*SMACK*, *SLAM*, take that " ++ x ++ "!")+ ,(\_ -> "/me activates her slap-o-matic...")+ ,(\x -> "/me orders her trained monkeys to punch " ++ x)+ ,(\x -> "/me smashes a lamp on " ++ possesiveForm x ++ " head")+ ,(\x -> "/me hits " ++ x ++ " with a hammer, so they breaks into a thousand pieces")+ ,(\x -> "/me throws some pointy lambdas at " ++ x)+ ,(\x -> "/me loves " ++ x ++ ", so no slapping")+ ,(\x -> "/me would never hurt " ++ x ++ "!")+ ,(\x -> "go slap " ++ x ++ " yourself")+ ,(\_ -> "I won't; I want to go get some cookies instead.")+ ,(\x -> "I'd rather not; " ++ x ++ " looks rather dangerous.")+ ,(\_ -> "I don't perform such side effects on command!")+ ,(\_ -> "stop telling me what to do")+ ,(\x -> "/me clobbers " ++ x ++ " with an untyped language")+ ,(\x -> "/me pulls " ++ x ++ " through the Evil Mangler")+ ,(\x -> "/me secretly deletes " ++ possesiveForm x ++ " source code")+ ,(\x -> "/me places her fist firmly on " ++ possesiveForm x ++ " jaw")+ ,(\x -> "/me locks up " ++ x ++ " in a Monad")+ ,(\x -> "/me submits " ++ possesiveForm x ++ " email address to a dozen spam lists")+ ,(\x -> "/me moulds " ++ x ++ " into a delicous cookie, and places it in her oven")+ ,(\_ -> "/me will count to five...")+ ,(\x -> "/me jabs " ++ x ++ " with a C pointer")+ ,(\x -> "/me is overcome by a sudden desire to hurt " ++ x)+ ,(\x -> "/me karate-chops " ++ x ++ " into two equally sized halves")+ ,(\x -> "Come on, let's all slap " ++ x)+ ,(\x -> "/me pushes " ++ x ++ " from his chair")+ ,(\x -> "/me hits " ++ x ++ " with an assortment of kitchen utensils")+ ,(\x -> "/me slaps " ++ x ++ " with a slab of concrete")+ ,(\x -> "/me puts on her slapping gloves, and slaps " ++ x)+ ,(\x -> "/me decomposes " ++ x ++ " into several parts using the Banach-Tarski theorem and reassembles them to get two copies of " ++ x ++ "!")+ ]++-- | The possesive form of a name, "x's"+possesiveForm :: String -> String+possesiveForm [] = []+possesiveForm x+ | last x == 's' = x ++ "'"+ | otherwise = x ++ "'s"
+ src/Lambdabot/Plugin/Novelty/Unlambda.hs view
@@ -0,0 +1,32 @@+-- Copyright (c) 2006 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)+--+-- | A plugin for the Haskell interpreter for the unlambda language+--+-- http://www.madore.org/~david/programs/unlambda/+module Lambdabot.Plugin.Novelty.Unlambda (unlambdaPlugin) where++import Lambdabot.Config.Novelty+import Lambdabot.Plugin+import Lambdabot.Util.Process+import Text.Regex.TDFA++unlambdaPlugin :: Module ()+unlambdaPlugin = newModule+ { moduleCmds = return+ [ (command "unlambda")+ { help = say "unlambda <expr>. Evaluate an unlambda expression"+ , process = \msg -> do+ binary <- getConfig unlambdaBinary+ ios80 (run binary msg scrub)+ }+ ]+ }++scrub :: String -> String+scrub = unlines . take 6 . map (' ':) . lines . cleanit++cleanit :: String -> String+cleanit s | s =~ terminated = "Terminated\n"+ | otherwise = s+ where terminated = "waitForProc"
+ src/Lambdabot/Plugin/Novelty/Vixen.hs view
@@ -0,0 +1,97 @@+-- | Talk to hot chixxors.++-- (c) Mark Wotton+-- Serialisation (c) 2007 Don Stewart++module Lambdabot.Plugin.Novelty.Vixen (vixenPlugin) where++import Lambdabot.Plugin+import Lambdabot.Util++import Control.Arrow ((***))+import Control.Monad+import Data.Binary+import qualified Data.ByteString.Char8 as P+import System.Directory+import Text.Regex.TDFA++vixenPlugin :: Module (Bool, String -> IO [Char])+vixenPlugin = newModule+ { moduleCmds = return+ [ (command "vixen")+ { help = say "vixen <phrase>. Sergeant Curry's lonely hearts club"+ , process = \txt -> say =<< io . ($ txt) . snd =<< readMS+ }+ , (command "vixen-on")+ { privileged = True+ , help = do+ me <- showNick =<< getLambdabotName+ say ("vixen-on: turn " ++ me ++ " into a chatterbot")+ , process = const $ do+ modifyMS $ \(_,r) -> (True, r)+ say "What's this channel about?"+ }+ , (command "vixen-off")+ { privileged = True+ , help = do+ me <- showNick =<< getLambdabotName+ say ("vixen-off: shut " ++ me ++ "up")+ , process = const $ do+ modifyMS $ \(_,r) -> (False, r)+ say "Bye!"+ }+ ]++ -- if vixen-chat is on, we can just respond to anything+ , contextual = \txt -> do+ (alive, k) <- readMS+ if alive then io (k txt) >>= say+ else return ()++ , moduleDefState = return (False, const (return "<undefined>"))++ -- suck in our (read only) regex state from disk+ -- compile it, and stick it in the plugin state+ , moduleInit = do+ vixenFile <- lb (findOrCreateLBFile "vixen")+ b <- io (doesFileExist vixenFile)+ when b $ do+ st <- io (decodeFile vixenFile)+ let compiled = map (makeRegex *** id) (st :: [(String, WTree)])+ s = vixen (mkResponses compiled)+ modifyMS $ \(v,_) -> (v, s)+ }++------------------------------------------------------------------------++vixen :: (String -> WTree) -> String -> IO String+vixen k key = P.unpack `fmap` randomW (k key)++randomW :: WTree -> IO P.ByteString+randomW (Leaf a) = return a+randomW (Node ls) = random ls >>= randomW++mkResponses :: RChoice -> String -> WTree+mkResponses choices them = (\((_,wtree):_) -> wtree) $+ filter (\(reg,_) -> match reg them) choices++------------------------------------------------------------------------+-- serialisation for the vixen state+--+-- The tree of regexes and responses is written in binary form to+-- State/vixen, and we suck it in on module init, then lazily regexify it all++data WTree = Leaf !P.ByteString | Node ![WTree]+ deriving Show++instance Binary WTree where+ put (Leaf s) = putWord8 0 >> put s+ put (Node ls) = putWord8 1 >> put ls+ get = do+ tag <- getWord8+ case tag of+ 0 -> liftM Leaf get+ 1 -> liftM Node get+ _ -> error "Vixen plugin error: unknown tag"++type RChoice = [(Regex, WTree)] -- compiled choices
+ src/Lambdabot/Util/Process.hs view
@@ -0,0 +1,19 @@+-- Copyright (c) 2004-6 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)++module Lambdabot.Util.Process+ ( run+ ) where++import System.Process++run :: FilePath -> String -> (String -> String) -> IO String+run binary src scrub = do+ (_,out,err) <- readProcessWithExitCode binary [] src+ let o = scrub out+ e = scrub err+ return $ case () of {_+ | null o && null e -> "Done."+ | null o -> e+ | otherwise -> o+ }