{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
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 :: Module (Map Key [Key])
quotePlugin = forall st. Module st
newModule
{ moduleSerialize :: Maybe (Serial (Map Key [Key]))
moduleSerialize = forall a. a -> Maybe a
Just Serial (Map Key [Key])
mapListPackedSerial
, moduleDefState :: LB (Map Key [Key])
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty
, moduleInit :: ModuleT (Map Key [Key]) LB ()
moduleInit = forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS (forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null))
, moduleCmds :: ModuleT (Map Key [Key]) LB [Command Quote]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"quote")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"quote <nick>: Quote <nick> or a random person if no nick is given"
, process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
}
, (String -> Command Identity
command String
"remember")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"remember <nick> <quote>: Remember that <nick> said <quote>."
, process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runRemember forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
}
, (String -> Command Identity
command String
"forget")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"forget nick quote. Delete a quote"
, process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runForget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
}
, (String -> Command Identity
command String
"ghc")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ghc. Choice quotes from GHC."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"ghc"])
}
, (String -> Command Identity
command String
"fortune")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"fortune. Provide a random fortune"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [])
}
, (String -> Command Identity
command String
"yow")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"yow. The zippy man."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"zippy"])
}
, (String -> Command Identity
command String
"arr")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"arr. Talk to a pirate"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"arr"])
}
, (String -> Command Identity
command String
"yarr")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"yarr. Talk to a scurvy pirate"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"arr", String
"yarr"])
}
, (String -> Command Identity
command String
"keal")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"keal. Talk like Keal"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"keal"])
}
, (String -> Command Identity
command String
"b52s")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"b52s. Anyone noticed the b52s sound a lot like zippy?"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"b52s"])
}
, (String -> Command Identity
command String
"pinky")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"pinky. Pinky and the Brain"
, process :: String -> Cmd Quote ()
process = \String
s -> [String] -> Cmd Quote ()
fortune forall a b. (a -> b) -> a -> b
$ if String
"pondering" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s
then [String
"pinky-pondering"]
else [String
"pinky-pondering", String
"pinky"]
}
, (String -> Command Identity
command String
"brain")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"brain. Pinky and the Brain"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"brain"])
}
, (String -> Command Identity
command String
"palomer")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"palomer. Sound a bit like palomer on a good day."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"palomer"])
}
, (String -> Command Identity
command String
"girl19")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"girl19 wonders what \"discriminating hackers\" are."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"girl19"])
}
, (String -> Command Identity
command String
"v")
{ aliases :: [String]
aliases = [String
"yhjulwwiefzojcbxybbruweejw"]
, help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => Cmd m String
getCmdName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
v -> case String
v of
String
"v" -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"let v = show v in v"
String
_ -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"V RETURNS!"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"notoriousV"])
}
, (String -> Command Identity
command String
"protontorpedo")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"protontorpedo is silly"
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"protontorpedo"])
}
, (String -> Command Identity
command String
"nixon")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Richard Nixon's finest."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"nixon"])
}
, (String -> Command Identity
command String
"farber")
{ help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Farberisms in the style of David Farber."
, process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"farber"])
}
]
}
fortune :: [FilePath] -> Cmd Quote ()
fortune :: [String] -> Cmd Quote ()
fortune [String]
xs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (FortuneType -> [String] -> IO [String]
resolveFortuneFiles FortuneType
All [String]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO String
randomFortune) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => String -> Cmd m ()
say
runRemember :: String -> Cmd Quote ()
runRemember :: String -> Cmd Quote ()
runRemember String
str
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
| Bool
otherwise = do
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Quote)
fm LBState (Cmd Quote) -> Cmd Quote ()
writer -> do
let ss :: [Key]
ss = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Key
P.pack String
nm) LBState (Cmd Quote)
fm)
fm' :: Map Key [Key]
fm' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> Key
P.pack String
nm) (String -> Key
P.pack String
q forall a. a -> [a] -> [a]
: [Key]
ss) LBState (Cmd Quote)
fm
LBState (Cmd Quote) -> Cmd Quote ()
writer Map Key [Key]
fm'
forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
randomSuccessMsg
where
(String
nm,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
q :: String
q = forall a. Int -> [a] -> [a]
drop Int
1 String
rest
runForget :: String -> Cmd Quote ()
runForget :: String -> Cmd Quote ()
runForget String
str
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
| Bool
otherwise = do
[Key]
ss <- forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Quote)
fm LBState (Cmd Quote) -> Cmd Quote ()
writer -> do
let ss :: [Key]
ss = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Key
P.pack String
nm) LBState (Cmd Quote)
fm)
fm' :: Map Key [Key]
fm' = case forall a. Eq a => a -> [a] -> [a]
delete (String -> Key
P.pack String
q) [Key]
ss of
[] -> forall k a. Ord k => k -> Map k a -> Map k a
M.delete (String -> Key
P.pack String
nm) LBState (Cmd Quote)
fm
[Key]
ss' -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> Key
P.pack String
nm) [Key]
ss' LBState (Cmd Quote)
fm
LBState (Cmd Quote) -> Cmd Quote ()
writer Map Key [Key]
fm'
forall (m :: * -> *) a. Monad m => a -> m a
return [Key]
ss
forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall a b. (a -> b) -> a -> b
$ if String -> Key
P.pack String
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
ss
then String
"Done."
else String
"No match."
where
(String
nm,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
q :: String
q = forall a. Int -> [a] -> [a]
drop Int
1 String
rest
runQuote :: String -> Cmd Quote ()
runQuote :: String -> Cmd Quote ()
runQuote String
str =
forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Key -> Map Key [Key] -> Cmd Quote String
search (String -> Key
P.pack String
nm) (String -> Key
P.pack String
pat) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
where (String
nm, String
p) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
pat :: String
pat = forall a. Int -> [a] -> [a]
drop Int
1 String
p
search :: Key -> P.ByteString -> Quotes -> Cmd Quote String
search :: Key -> Key -> Map Key [Key] -> Cmd Quote String
search Key
key Key
pat Map Key [Key]
db
| forall k a. Map k a -> Bool
M.null Map Key [Key]
db = forall (m :: * -> *) a. Monad m => a -> m a
return String
"No quotes yet."
| Key -> Bool
P.null Key
key = do
(Key
key', [Key]
qs) <- forall (m :: * -> *) a. MonadIO m => [a] -> m a
random (forall k a. Map k a -> [(k, a)]
M.toList Map Key [Key]
db)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Key -> String
display Key
key') (forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [Key]
qs)
| Key -> Bool
P.null Key
pat, Just [Key]
qs <- Maybe [Key]
mquotes =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Key -> String
display Key
key) (forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [Key]
qs)
| Key -> Bool
P.null Key
pat = forall source.
RegexMaker Regex CompOption ExecOption source =>
source -> [(Key, Key)] -> Cmd Quote String
match' Key
key [(Key, Key)]
allquotes
| Just [Key]
qs <- Maybe [Key]
mquotes = forall source.
RegexMaker Regex CompOption ExecOption source =>
source -> [(Key, Key)] -> Cmd Quote String
match' Key
pat (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Key
key) [Key]
qs)
| Bool
otherwise = do
String
r <- forall (m :: * -> *). (MonadIO m, MonadConfig m) => m String
randomFailureMsg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No quotes for this person. " forall a. [a] -> [a] -> [a]
++ String
r
where
mquotes :: Maybe [Key]
mquotes = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key Map Key [Key]
db
allquotes :: [(Key, Key)]
allquotes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Key
who) [Key]
qs | (Key
who, [Key]
qs) <- forall k a. Map k a -> [(k, a)]
M.assocs Map Key [Key]
db ]
match' :: RegexMaker Regex CompOption ExecOption source => source -> [(P.ByteString, P.ByteString)] -> Cmd Quote String
match' :: forall source.
RegexMaker Regex CompOption ExecOption source =>
source -> [(Key, Key)] -> Cmd Quote String
match' source
p [(Key, Key)]
ss = do
Regex
re <- forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt {caseSensitive :: Bool
caseSensitive = Bool
False, newSyntax :: Bool
newSyntax = Bool
True}
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False} source
p
let rs :: [(Key, Key)]
rs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
re forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Key, Key)]
ss
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Key, Key)]
rs
then do String
r <- forall (m :: * -> *). (MonadIO m, MonadConfig m) => m String
randomFailureMsg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No quotes match. " forall a. [a] -> [a] -> [a]
++ String
r
else do (Key
who, Key
saying) <- forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [(Key, Key)]
rs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Key -> String
P.unpack Key
who forall a. [a] -> [a] -> [a]
++ String
" says: " forall a. [a] -> [a] -> [a]
++ Key -> String
P.unpack Key
saying
display :: Key -> Key -> String
display Key
k Key
msg = (if Key -> Bool
P.null Key
k then String
" " else String
who forall a. [a] -> [a] -> [a]
++ String
" says: ") forall a. [a] -> [a] -> [a]
++ String
saying
where saying :: String
saying = Key -> String
P.unpack Key
msg
who :: String
who = Key -> String
P.unpack Key
k