-- | Karma
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 = Module KarmaState
forall st. Module st
newModule
    { moduleCmds :: ModuleT KarmaState LB [Command Karma]
moduleCmds = [Command Karma] -> ModuleT KarmaState LB [Command Karma]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ ([Char] -> Command Identity
command [Char]
"karma")
            { help :: Cmd Karma ()
help = [Char] -> Cmd Karma ()
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 a. Message a => a -> Cmd Karma ()) -> Cmd Karma ()
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a. Message a => a -> Cmd Karma ()) -> Cmd Karma ())
-> (forall a. Message a => a -> Cmd Karma ()) -> Cmd Karma ()
forall a b. (a -> b) -> a -> b
$ \a
msg -> do
                Nick
sender <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Nick -> Polynick -> Cmd Karma ()
tellKarma Nick
sender (Polynick -> Cmd Karma ()) -> Polynick -> Cmd Karma ()
forall a b. (a -> b) -> a -> b
$ case [Char] -> [[Char]]
words [Char]
rest of
                    []       -> Nick -> Polynick
E.mononickToPolynick Nick
sender
                    ([Char]
nick:[[Char]]
_) -> a -> [Char] -> Polynick
forall a. Message a => a -> [Char] -> Polynick
E.readPolynick a
msg [Char]
nick

            }
        , ([Char] -> Command Identity
command [Char]
"karma+")
            { help :: Cmd Karma ()
help = [Char] -> Cmd Karma ()
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 = [Char] -> Cmd Karma ()
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 = [Char] -> Cmd Karma ()
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"karma-all. List all karma"
            , process :: [Char] -> Cmd Karma ()
process = Cmd Karma () -> [Char] -> Cmd Karma ()
forall a b. a -> b -> a
const Cmd Karma ()
listKarma
            }
        ]

    , moduleDefState :: LB KarmaState
moduleDefState  = KarmaState -> LB KarmaState
forall (m :: * -> *) a. Monad m => a -> m a
return (KarmaState -> LB KarmaState) -> KarmaState -> LB KarmaState
forall a b. (a -> b) -> a -> b
$ KarmaState
forall k a. Map k a
M.empty
    , moduleSerialize :: Maybe (Serial KarmaState)
moduleSerialize = Serial KarmaState -> Maybe (Serial KarmaState)
forall a. a -> Maybe a
Just Serial KarmaState
forall v. (Show v, Read v) => Serial (Map Nick v)
freenodeNickMapSerial

    -- nick++($| )
    , contextual :: [Char] -> Cmd Karma ()
contextual = \[Char]
text -> (forall a. Message a => a -> Cmd Karma ()) -> Cmd Karma ()
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a. Message a => a -> Cmd Karma ()) -> Cmd Karma ())
-> (forall a. Message a => a -> Cmd Karma ()) -> Cmd Karma ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
        Nick
sender <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender

        let ws :: [[Char]]
ws          = [Char] -> [[Char]]
words [Char]
text
            decs :: Cmd Karma [Nick]
decs        = [Char] -> Cmd Karma [Nick]
forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"--"
            incs :: Cmd Karma [Nick]
incs        = [Char] -> Cmd Karma [Nick]
forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"++"
            match :: [Char] -> Cmd m [Nick]
match [Char]
m     = ([Char] -> Cmd m Nick) -> [[Char]] -> Cmd m [Nick]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> Cmd m Nick
forall (m :: * -> *). Monad m => [Char] -> Cmd m Nick
readNick ([[Char]] -> Cmd m [Nick])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Cmd m [Nick]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
okay ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2)
                        ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
m) ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
forall a. [a] -> [a]
reverse ([[Char]] -> Cmd m [Nick]) -> [[Char]] -> Cmd m [Nick]
forall a b. (a -> b) -> a -> b
$ [[Char]]
ws
            okay :: [Char] -> Bool
okay [Char]
x      = Bool -> Bool
not ([Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
x [[Char]]
badNicks Bool -> Bool -> Bool
|| ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x) [[Char]]
badPrefixes)
            -- Special cases.  Ignore the null nick.  C must also be ignored
            -- because C++ and C-- are languages.
            badNicks :: [[Char]]
badNicks    = [[Char]
"", [Char]
"C", [Char]
"c", [Char]
"notepad"]
            -- More special cases, to ignore Perl code.
            badPrefixes :: [[Char]]
badPrefixes = [[Char]
"$", [Char]
"@", [Char]
"%"]

        (Nick -> Cmd Karma [Char]) -> [Nick] -> Cmd Karma ()
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) ([Nick] -> Cmd Karma ()) -> Cmd Karma [Nick] -> Cmd Karma ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd Karma [Nick]
decs
        (Nick -> Cmd Karma [Char]) -> [Nick] -> Cmd Karma ()
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) ([Nick] -> Cmd Karma ()) -> Cmd Karma [Nick] -> Cmd Karma ()
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 <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    case [Char] -> [[Char]]
words [Char]
rest of
      []       -> [Char] -> Cmd Karma ()
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"usage @karma(+|-) nick"
      ([Char]
nick:[[Char]]
_) -> do
          Nick
nick' <- [Char] -> Cmd Karma 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' Cmd Karma [Char] -> ([Char] -> Cmd Karma ()) -> Cmd Karma ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Cmd Karma ()
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' <- LB (Polynick -> KarmaState -> [(Nick, Integer)])
-> Cmd Karma (Polynick -> KarmaState -> [(Nick, Integer)])
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb LB (Polynick -> KarmaState -> [(Nick, Integer)])
forall a. LB (Polynick -> Map Nick a -> [(Nick, a)])
E.lookupMononickMap
    Integer
karma <- ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> (KarmaState -> [Integer]) -> KarmaState -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Nick, Integer) -> Integer) -> [(Nick, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Nick, Integer) -> Integer
forall a b. (a, b) -> b
snd ([(Nick, Integer)] -> [Integer])
-> (KarmaState -> [(Nick, Integer)]) -> KarmaState -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polynick -> KarmaState -> [(Nick, Integer)]
lookup' Polynick
nick) (KarmaState -> Integer)
-> Cmd Karma KarmaState -> Cmd Karma Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Cmd Karma KarmaState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    [Char]
nickStr <- (forall a. Message a => a -> Cmd Karma [Char]) -> Cmd Karma [Char]
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ([Char] -> Cmd Karma [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Cmd Karma [Char])
-> (a -> [Char]) -> a -> Cmd Karma [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Polynick -> [Char]) -> Polynick -> a -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Polynick -> [Char]
forall a. Message a => a -> Polynick -> [Char]
E.showPolynick Polynick
nick)
    [Char] -> Cmd Karma ()
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say ([Char] -> Cmd Karma ()) -> [Char] -> Cmd Karma ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Nick -> Polynick
E.mononickToPolynick Nick
sender Polynick -> Polynick -> Bool
forall a. Eq a => a -> a -> Bool
== Polynick
nick then [Char]
"You have" else [Char]
nickStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" has"
                   ,[Char]
" a karma of "
                   ,Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
karma]

listKarma :: Cmd Karma ()
listKarma :: Cmd Karma ()
listKarma = do
    [(Nick, Integer)]
ks <- KarmaState -> [(Nick, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (KarmaState -> [(Nick, Integer)])
-> Cmd Karma KarmaState -> Cmd Karma [(Nick, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Cmd Karma KarmaState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    let ks' :: [(Nick, Integer)]
ks' = ((Nick, Integer) -> (Nick, Integer) -> Ordering)
-> [(Nick, Integer)] -> [(Nick, Integer)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Nick
_,Integer
e) (Nick
_,Integer
e') -> Integer
e' Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
e) [(Nick, Integer)]
ks
    (((Nick, Integer) -> Cmd Karma ())
 -> [(Nick, Integer)] -> Cmd Karma ())
-> [(Nick, Integer)]
-> ((Nick, Integer) -> Cmd Karma ())
-> Cmd Karma ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Nick, Integer) -> Cmd Karma ())
-> [(Nick, Integer)] -> Cmd Karma ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [(Nick, Integer)]
ks' (((Nick, Integer) -> Cmd Karma ()) -> Cmd Karma ())
-> ((Nick, Integer) -> Cmd Karma ()) -> Cmd Karma ()
forall a b. (a -> b) -> a -> b
$ \(Nick
k,Integer
e) -> do
        [Char]
k' <- Nick -> Cmd Karma [Char]
forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
k
        [Char] -> Cmd Karma ()
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say ([Char] -> [Char] -> Integer -> [Char]
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
    | (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Nick -> [Char]
nName Nick
nick) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"java" Bool -> Bool -> Bool
&& Integer
km Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = do
        Nick
me <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
        Integer -> Nick -> Nick -> Cmd Karma [Char]
changeKarma (-Integer
km) Nick
me Nick
sender
    | Nick
sender Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
nick = [Char] -> Cmd Karma [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"You can't change your own karma, silly."
    | Bool
otherwise      = do
        [Char]
nickStr <- Nick -> Cmd Karma [Char]
forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
nick
        (LBState (Cmd Karma)
 -> (LBState (Cmd Karma) -> Cmd Karma ()) -> Cmd Karma [Char])
-> Cmd Karma [Char]
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd Karma)
  -> (LBState (Cmd Karma) -> Cmd Karma ()) -> Cmd Karma [Char])
 -> Cmd Karma [Char])
-> (LBState (Cmd Karma)
    -> (LBState (Cmd Karma) -> Cmd Karma ()) -> Cmd Karma [Char])
-> Cmd Karma [Char]
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Karma)
fm LBState (Cmd Karma) -> Cmd Karma ()
write -> do
            let fm' :: KarmaState
fm' = (Integer -> Integer -> Integer)
-> Nick -> Integer -> KarmaState -> KarmaState
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Nick
nick Integer
km KarmaState
LBState (Cmd Karma)
fm
            let karma :: Integer
karma = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Nick -> KarmaState -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nick
nick KarmaState
fm'
            LBState (Cmd Karma) -> Cmd Karma ()
write KarmaState
LBState (Cmd Karma)
fm'
            [Char] -> Cmd Karma [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Integer -> [Char] -> [Char]
forall {a}. (Ord a, Num a) => [Char] -> a -> [Char] -> [Char]
fmt [Char]
nickStr Integer
km (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
karma))
        where
            fmt :: [Char] -> a -> [Char] -> [Char]
fmt [Char]
n a
v [Char]
k | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma lowered to "    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                      | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma unchanged at "  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                      | Bool
otherwise = [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'s karma raised to "     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."