module Lambdabot.Plugin.Social.Karma (karmaPlugin) where
import Lambdabot.Compat.FreenodeNick
import Lambdabot.Plugin
import qualified Lambdabot.Util.NickEq as E
import Data.Char
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Text.Printf
type KarmaState = M.Map Nick Integer
type Karma = ModuleT KarmaState LB
karmaPlugin :: Module KarmaState
karmaPlugin :: Module KarmaState
karmaPlugin = forall st. Module st
newModule
{ moduleCmds :: ModuleT KarmaState LB [Command Karma]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
[ ([Char] -> Command Identity
command [Char]
"karma")
{ help :: Cmd Karma ()
help = forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"karma <polynick>. Return a person's karma value"
, process :: [Char] -> Cmd Karma ()
process = \[Char]
rest -> forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a b. (a -> b) -> a -> b
$ \a
msg -> do
Nick
sender <- forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Nick -> Polynick -> Cmd Karma ()
tellKarma Nick
sender forall a b. (a -> b) -> a -> b
$ case [Char] -> [[Char]]
words [Char]
rest of
[] -> Nick -> Polynick
E.mononickToPolynick Nick
sender
([Char]
nick:[[Char]]
_) -> forall a. Message a => a -> [Char] -> Polynick
E.readPolynick a
msg [Char]
nick
}
, ([Char] -> Command Identity
command [Char]
"karma+")
{ help :: Cmd Karma ()
help = forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"karma+ <nick>. Increment someone's karma"
, process :: [Char] -> Cmd Karma ()
process = Integer -> [Char] -> Cmd Karma ()
doCmd Integer
1
}
, ([Char] -> Command Identity
command [Char]
"karma-")
{ help :: Cmd Karma ()
help = forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"karma- <nick>. Decrement someone's karma"
, process :: [Char] -> Cmd Karma ()
process = Integer -> [Char] -> Cmd Karma ()
doCmd (-Integer
1)
}
, ([Char] -> Command Identity
command [Char]
"karma-all")
{ help :: Cmd Karma ()
help = forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"karma-all. List all karma"
, process :: [Char] -> Cmd Karma ()
process = forall a b. a -> b -> a
const Cmd Karma ()
listKarma
}
]
, moduleDefState :: LB KarmaState
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Map k a
M.empty
, moduleSerialize :: Maybe (Serial KarmaState)
moduleSerialize = forall a. a -> Maybe a
Just forall v. (Show v, Read v) => Serial (Map Nick v)
freenodeNickMapSerial
, contextual :: [Char] -> Cmd Karma ()
contextual = \[Char]
text -> forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a b. (a -> b) -> a -> b
$ \a
_ -> do
Nick
sender <- forall (m :: * -> *). Monad m => Cmd m Nick
getSender
let ws :: [[Char]]
ws = [Char] -> [[Char]]
words [Char]
text
decs :: Cmd Karma [Nick]
decs = forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"--"
incs :: Cmd Karma [Nick]
incs = forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"++"
match :: [Char] -> Cmd m [Nick]
match [Char]
m = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Monad m => [Char] -> Cmd m Nick
readNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
okay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [[Char]]
ws
okay :: [Char] -> Bool
okay [Char]
x = Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
x [[Char]]
badNicks Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x) [[Char]]
badPrefixes)
badNicks :: [[Char]]
badNicks = [[Char]
"", [Char]
"C", [Char]
"c", [Char]
"notepad"]
badPrefixes :: [[Char]]
badPrefixes = [[Char]
"$", [Char]
"@", [Char]
"%"]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma (-Integer
1) Nick
sender) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd Karma [Nick]
decs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma Integer
1 Nick
sender) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd Karma [Nick]
incs
}
doCmd :: Integer -> String -> Cmd Karma ()
doCmd :: Integer -> [Char] -> Cmd Karma ()
doCmd Integer
dk [Char]
rest = do
Nick
sender <- forall (m :: * -> *). Monad m => Cmd m Nick
getSender
case [Char] -> [[Char]]
words [Char]
rest of
[] -> forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"usage @karma(+|-) nick"
([Char]
nick:[[Char]]
_) -> do
Nick
nick' <- forall (m :: * -> *). Monad m => [Char] -> Cmd m Nick
readNick [Char]
nick
Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma Integer
dk Nick
sender Nick
nick' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say
tellKarma :: Nick -> E.Polynick -> Cmd Karma ()
tellKarma :: Nick -> Polynick -> Cmd Karma ()
tellKarma Nick
sender Polynick
nick = do
Polynick -> KarmaState -> [(Nick, Integer)]
lookup' <- forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a. LB (Polynick -> Map Nick a -> [(Nick, a)])
E.lookupMononickMap
Integer
karma <- (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polynick -> KarmaState -> [(Nick, Integer)]
lookup' Polynick
nick) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
[Char]
nickStr <- forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Message a => a -> Polynick -> [Char]
E.showPolynick Polynick
nick)
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Nick -> Polynick
E.mononickToPolynick Nick
sender forall a. Eq a => a -> a -> Bool
== Polynick
nick then [Char]
"You have" else [Char]
nickStr forall a. [a] -> [a] -> [a]
++ [Char]
" has"
,[Char]
" a karma of "
,forall a. Show a => a -> [Char]
show Integer
karma]
listKarma :: Cmd Karma ()
listKarma :: Cmd Karma ()
listKarma = do
[(Nick, Integer)]
ks <- forall k a. Map k a -> [(k, a)]
M.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
let ks' :: [(Nick, Integer)]
ks' = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Nick
_,Integer
e) (Nick
_,Integer
e') -> Integer
e' forall a. Ord a => a -> a -> Ordering
`compare` Integer
e) [(Nick, Integer)]
ks
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [(Nick, Integer)]
ks' forall a b. (a -> b) -> a -> b
$ \(Nick
k,Integer
e) -> do
[Char]
k' <- forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
k
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say (forall r. PrintfType r => [Char] -> r
printf [Char]
" %-20s %4d" [Char]
k' Integer
e)
changeKarma :: Integer -> Nick -> Nick -> Cmd Karma String
changeKarma :: Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma Integer
km Nick
sender Nick
nick
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Nick -> [Char]
nName Nick
nick) forall a. Eq a => a -> a -> Bool
== [Char]
"java" Bool -> Bool -> Bool
&& Integer
km forall a. Ord a => a -> a -> Bool
> Integer
0 = do
Nick
me <- forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma (-Integer
km) Nick
me Nick
sender
| Nick
sender forall a. Eq a => a -> a -> Bool
== Nick
nick = forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"You can't change your own karma, silly."
| Bool
otherwise = do
[Char]
nickStr <- forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
nick
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Karma)
fm LBState (Cmd Karma) -> Cmd Karma ()
write -> do
let fm' :: KarmaState
fm' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Num a => a -> a -> a
(+) Nick
nick Integer
km LBState (Cmd Karma)
fm
let karma :: Integer
karma = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nick
nick KarmaState
fm'
LBState (Cmd Karma) -> Cmd Karma ()
write KarmaState
fm'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}. (Ord a, Num a) => [Char] -> a -> [Char] -> [Char]
fmt [Char]
nickStr Integer
km (forall a. Show a => a -> [Char]
show Integer
karma))
where
fmt :: [Char] -> a -> [Char] -> [Char]
fmt [Char]
n a
v [Char]
k | a
v forall a. Ord a => a -> a -> Bool
< a
0 = [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma lowered to " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"."
| a
v forall a. Eq a => a -> a -> Bool
== a
0 = [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma unchanged at " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"."
| Bool
otherwise = [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma raised to " forall a. [a] -> [a] -> [a]
++ [Char]
k forall a. [a] -> [a] -> [a]
++ [Char]
"."