lambdabot-novelty-plugins-5.1/0000755000000000000000000000000012722676543014665 5ustar0000000000000000lambdabot-novelty-plugins-5.1/LICENSE0000644000000000000000000000225612722676543015677 0ustar0000000000000000Copyright (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. lambdabot-novelty-plugins-5.1/lambdabot-novelty-plugins.cabal0000644000000000000000000000603012722676543022752 0ustar0000000000000000name: lambdabot-novelty-plugins version: 5.1 license: GPL license-file: LICENSE author: Don Stewart maintainer: James Cook 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.8.4, GHC == 7.10.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.1 && < 5.2, misfortune >= 0.1, process >= 1.1, random-fu >= 0.2, regex-tdfa >= 1.1, -- runtime dependencies brainfuck >= 0.1, unlambda >= 0.1 lambdabot-novelty-plugins-5.1/Setup.hs0000644000000000000000000000014212722676543016316 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMainWithHooks defaultUserHooks lambdabot-novelty-plugins-5.1/src/0000755000000000000000000000000012722676543015454 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/0000755000000000000000000000000012722676543017341 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/Util/0000755000000000000000000000000012722676543020256 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/Util/Process.hs0000644000000000000000000000103412722676543022226 0ustar0000000000000000-- 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 } lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/0000755000000000000000000000000012722676543020577 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty.hs0000644000000000000000000000142612722676543022576 0ustar0000000000000000module 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"] lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/0000755000000000000000000000000012722676543022237 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Filter.hs0000644000000000000000000000463112722676543024024 0ustar0000000000000000-- | 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 ++ " ") t -> ios80 (runFilter path (unwords t)) } | (name, path, descr) <- activeFilters ] } filters :: [(String, String)] filters = [ ("austro", "austro . Talk like Ahhhnold") , ("b1ff", "b1ff . B1ff of usenet yore") , ("brooklyn", "brooklyn . Yo") , ("chef", "chef . Bork bork bork") , ("cockney", "cockney . Londoner accent") , ("drawl", "drawl . Southern drawl") , ("dubya", "dubya . Presidential filter") , ("fudd", "fudd . Fudd, Elmer") , ("funetak", "funetak . Southern drawl") , ("jethro", "jethro . Now listen to a story 'bout a man named Jed...") , ("jive", "jive . Slap ma fro") , ("kraut", "kraut . German accent") , ("pansy", "pansy . Effeminate male") , ("pirate", "pirate . Talk like a pirate") , ("postmodern", "postmodern . Feminazi") , ("redneck", "redneck . Deep south") , ("valspeak", "valley . Like, ya know?") , ("warez", "warez . 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Vixen.hs0000644000000000000000000000576412722676543023700 0ustar0000000000000000-- | 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 qualified Data.ByteString.Lazy as L import System.Directory import Text.Regex.TDFA vixenPlugin :: Module (Bool, String -> IO [Char]) vixenPlugin = newModule { moduleCmds = return [ (command "vixen") { help = say "vixen . 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 "")) -- suck in our (read only) regex state from disk -- compile it, and stick it in the plugin state , moduleSerialize = Just $ readOnly $ \bs -> let st = decode (L.fromStrict bs) compiled = map (makeRegex *** id) (st :: [(String, WTree)]) in (False, vixen (mkResponses compiled)) } ------------------------------------------------------------------------ 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Dice.hs0000644000000000000000000000217212722676543023441 0ustar0000000000000000-- | This module is for throwing dice for e.g. RPGs. (\@dice 3d6+2) -- Original version copyright Einar Karttunen 2005-04-06. -- Massive rewrite circa 2008-10-20 copyright James Cook 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 . Throw random dice. 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Quote.hs0000644000000000000000000001504612722676543023676 0ustar0000000000000000{-# 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 : Quote or a random person if no nick is given" , process = runQuote . strip isSpace } , (command "remember") { help = say "remember : Remember that said ." , 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/BF.hs0000644000000000000000000000235212722676543023064 0ustar0000000000000000-- 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 . 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Elite.hs0000644000000000000000000000543712722676543023646 0ustar0000000000000000-- (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 . 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" ) ] lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Slap.hs0000644000000000000000000000616612722676543023503 0ustar0000000000000000-- | 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 . 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" lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Numberwang.hs0000644000000000000000000000426612722676543024710 0ustar0000000000000000{-# 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 : 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 lambdabot-novelty-plugins-5.1/src/Lambdabot/Plugin/Novelty/Unlambda.hs0000644000000000000000000000176512722676543024327 0ustar0000000000000000-- 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 . 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" lambdabot-novelty-plugins-5.1/src/Lambdabot/Config/0000755000000000000000000000000012722676543020546 5ustar0000000000000000lambdabot-novelty-plugins-5.1/src/Lambdabot/Config/Novelty.hs0000644000000000000000000000054712722676543022550 0ustar0000000000000000{-# 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" |]