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
|
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
-- | Karma
module Plugin.Karma (theModule) where
import Plugin
import qualified Message as Msg (nick, Nick, Message, showNick, readNick, lambdabotName, nName)
import qualified NickEq as E
import qualified Data.Map as M
import Text.Printf
$(plugin "Karma")
type KarmaState = M.Map Msg.Nick Integer
type Karma m a = ModuleT KarmaState m a
instance Module KarmaModule KarmaState where
moduleCmds _ = ["karma", "karma+", "karma-", "karma-all"]
moduleHelp _ "karma" = "karma <polynick>. Return a person's karma value"
moduleHelp _ "karma+" = "karma+ <nick>. Increment someone's karma"
moduleHelp _ "karma-" = "karma- <nick>. Decrement someone's karma"
moduleHelp _ "karma-all" = "karma-all. List all karma"
moduleDefState _ = return $ M.empty
moduleSerialize _ = Just mapSerial
process _ _ _ "karma-all" _ = listKarma
process _ msg _ "karma" rest = tellKarma msg sender nick'
where sender = Msg.nick msg
nick' = case words rest of
[] -> E.mononickToPolynick sender
(nick:_) -> E.readPolynick msg nick
process _ msg _ cmd rest =
case words rest of
[] -> return [ "usage @karma(+|-) nick" ]
(nick:_) -> do
let nick' = Msg.readNick msg nick
case cmd of
"karma+" -> changeKarma msg 1 sender nick'
"karma-" -> changeKarma msg (-1) sender nick'
_ -> error "KarmaModule: can't happen"
where sender = Msg.nick msg
-- ^nick++($| )
contextual _ msg _ text = do
mapM_ (changeKarma msg (-1) sender) decs
mapM_ (changeKarma msg 1 sender) incs
return []
where
sender = Msg.nick msg
ws = words text
decs = match "--"
incs = match "++"
match m = map (Msg.readNick msg) . filter okay . map (reverse . drop 2)
. filter (isPrefixOf m) . map reverse $ ws
okay x = not (elem x badNicks || any (`isPrefixOf` x) badPrefixes)
-- Special cases. Ignore the null nick. C must also be ignored
-- because C++ and C-- are languages.
badNicks = ["", "C", "c", "notepad"]
-- More special cases, to ignore Perl code.
badPrefixes = ["$", "@", "%"]
------------------------------------------------------------------------
tellKarma :: Msg.Message m => m -> Msg.Nick -> E.Polynick -> Karma LB [String]
tellKarma msg sender nick = do
lookup' <- lift E.lookupMononickMap
karma <- (sum . map snd . lookup' nick) `fmap` readMS
return [concat [if E.mononickToPolynick sender == nick then "You have" else E.showPolynick msg nick ++ " has"
," a karma of "
,show karma]]
listKarma :: Karma LB [String]
listKarma = do
ks <- M.toList `fmap` readMS
let ks' = sortBy (\(_,e) (_,e') -> e' `compare` e) ks
return $ (:[]) . unlines $ map (\(k,e) -> printf " %-20s %4d" (show k) e :: String) ks'
changeKarma :: Msg.Message m => m -> Integer -> Msg.Nick -> Msg.Nick -> Karma LB [String]
changeKarma msg km sender nick
| map toLower (Msg.nName nick) == "java" && km == 1 = changeKarma msg (-km) (Msg.lambdabotName msg) sender
| sender == nick = return ["You can't change your own karma, silly."]
| otherwise = withMS $ \fm write -> do
let fm' = M.insertWith (+) nick km fm
let karma = fromMaybe 0 $ M.lookup nick fm'
write fm'
return [fmt (Msg.showNick msg nick) km (show karma)]
where fmt n v k | v < 0 = n ++ "'s karma lowered to " ++ k ++ "."
| otherwise = n ++ "'s karma raised to " ++ k ++ "."
|
