1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
{-# LANGUAGE TemplateHaskell, CPP, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, FlexibleInstances #-}
-- | Support for quotes
module Plugin.Quote (theModule) where
import Plugin
import Plugin.Quote.Fortune (randFortune)
import Plugin.Quote.Text
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as P
$(plugin "Quote")
type Key = P.ByteString
type Quotes = M.Map Key [P.ByteString]
instance Module QuoteModule Quotes where
moduleCmds _ = ["quote", "remember", "forget", "ghc", "fortune"
,"yow","arr","yarr","keal","b52s","brain","palomer"
,"girl19", "v", "yhjulwwiefzojcbxybbruweejw"
, "protontorpedo", "nixon", "farber"]
moduleHelp _ "forget" = "forget nick quote. Delete a quote"
moduleHelp _ "fortune" = "fortune. Provide a random fortune"
moduleHelp _ "yow" = "yow. The zippy man."
moduleHelp _ "arr" = "arr. Talk to a pirate"
moduleHelp _ "yarr" = "yarr. Talk to a pirate"
moduleHelp _ "keal" = "keal. Talk like Keal"
moduleHelp _ "ghc" = "ghc. Choice quotes from GHC."
moduleHelp _ "b52s" = "b52s. Anyone noticed the b52s sound a lot like zippy?"
moduleHelp _ "brain" = "brain. Pinky and the Brain"
moduleHelp _ "palomer" = "palomer. Sound a bit like palomer on a good day."
moduleHelp _ "protontorpedo" = "protontorpedo is silly"
moduleHelp _ "girl19" = "girl19 wonders what \"discriminating hackers\" are."
moduleHelp _ "v" = "let v = show v in v"
moduleHelp _ "yhjulwwiefzojcbxybbruweejw"
= "V RETURNS!"
moduleHelp _ "farber" = "Farberisms in the style of David Farber."
moduleHelp _ "nixon" = "Richad Nixon's finest."
moduleHelp _ _ = help -- required
moduleSerialize _ = Just mapListPackedSerial
moduleDefState _ = return M.empty
process_ _ cmd s = case cmd of
"forget" -> runForget (dropSpace s)
"remember" -> runRemember (dropSpace s)
"quote" -> runQuote (dropSpace s)
"ghc" -> runQuote ("ghc " ++ dropSpace s)
"fortune" -> runit (randFortune Nothing)
"yow" -> runit (randFortune (Just "zippy"))
"keal" -> rand kealList
"b52s" -> rand b52s
"brain" -> rand (if "pondering" `isInfixOf` s then brainPondering else brain)
"palomer" -> rand palomer
"girl19" -> rand girl19
"protontorpedo" -> rand protontorpedo
"v" -> rand notoriousV
"yhjulwwiefzojcbxybbruweejw"
-> rand notoriousV
-- See, you've got to understand the subtle distinction in pirate
-- talk between arr and yarr! arr is something you say as an
-- afermative where as yarr! is more like a greeting. (Or something)
"arr" -> rand arrList
"yarr" -> rand yarrList
"farber" -> rand farberList
"nixon" -> rand nixonList
where
runit k = return `fmap` io k
rand = runit . randomElem
help :: String
help = "quote <nick>\nremember <nick> <quote>\n" ++
"Quote somebody, a random person, or save a memorable quote"
------------------------------------------------------------------------
-- the @remember command stores away a quotation by a user, for future
-- use by @quote
-- error handling!
runRemember :: String -> ModuleLB Quotes
runRemember str
| null rest = return ["Incorrect arguments to quote"]
| otherwise = 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'
r <- random confirmation
box r
where
(nm,rest) = break isSpace str
q = tail rest
-- @forget, to remove a quote
runForget :: String -> ModuleLB Quotes
runForget str
| null rest = return ["Incorrect arguments to quote"]
| otherwise = withMS $ \fm writer -> do
let ss = fromMaybe [] (M.lookup (P.pack nm) fm)
fm' = M.insert (P.pack nm) (delete (P.pack q) ss) fm
writer fm'
if P.pack q `elem` ss
then return ["Done."]
else return ["No match."]
where
(nm,rest) = break isSpace str
q = tail rest
--
-- the @quote command, takes a user nm to choose a random quote from
--
runQuote :: String -> ModuleLB Quotes
runQuote str = do
st <- readMS
io (search (P.pack nm) (P.pack pat) st)
where (nm, p) = break isSpace str
pat = if null p then p else tail p
search :: Key -> P.ByteString -> Quotes -> IO [String]
search key pat db
| M.null db = box "No quotes yet."
| P.null key = do
(key', qs) <- random (M.toList db) -- quote a random person
box . display key' =<< random qs
| P.null pat, Just qs <- mquotes =
box . display key =<< random qs
| P.null pat = match key allquotes
| Just qs <- mquotes = match pat (zip (repeat key) qs)
| otherwise = do
r <- random insult
box $ "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
#if __GLASGOW_HASKELL__ >= 606
re <- do res <- compile (compExtended + compIgnoreCase + compNoSub) 0 p
case res of
Left err -> error $ "regex failed: " ++ show err
Right r -> return r
#else
let re = mkRegexWithOpts (P.unpack p) True True
#endif
let rs = filter (matches re . snd) ss
if null rs
then do r <- random insult
box $ "No quotes match. " ++ r
else do (who, saying) <- random rs
box $ 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
|
