-- | 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 = return
        [ (command "karma")
            { help = say "karma <polynick>. Return a person's karma value"
            , 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
                sender <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                tellKarma sender $ case words 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

            }
        , (command "karma+")
            { help = say "karma+ <nick>. Increment someone's karma"
            , process = doCmd 1
            }
        , (command "karma-")
            { help = say "karma- <nick>. Decrement someone's karma"
            , process = doCmd (-1)
            }
        , (command "karma-all")
            { help = say "karma-all. List all karma"
            , process = const listKarma
            }
        ]

    , moduleDefState  = return $ M.empty
    , moduleSerialize = Just freenodeNickMapSerial

    -- nick++($| )
    , 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
        sender <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender

        let ws          = [Char] -> [[Char]]
words [Char]
text
            decs        = [Char] -> Cmd Karma [Nick]
forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"--"
            incs        = [Char] -> Cmd Karma [Nick]
forall {m :: * -> *}. Monad m => [Char] -> Cmd m [Nick]
match [Char]
"++"
            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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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]
x      = Bool -> Bool
not ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> 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]
"", [Char]
"C", [Char]
"c", [Char]
"notepad"]
            -- More special cases, to ignore Perl code.
            badPrefixes = [[Char]
"$", [Char]
"@", [Char]
"%"]

        mapM_ (changeKarma (-1) sender) =<< decs
        mapM_ (changeKarma   1  sender) =<< incs
    }

doCmd :: Integer -> String -> Cmd Karma ()
doCmd :: Integer -> [Char] -> Cmd Karma ()
doCmd Integer
dk [Char]
rest = do
    sender <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    case words rest of
      []       -> [Char] -> Cmd Karma ()
forall (m :: * -> *). Monad m => [Char] -> Cmd m ()
say [Char]
"usage @karma(+|-) nick"
      ([Char]
nick:[[Char]]
_) -> do
          nick' <- [Char] -> Cmd Karma Nick
forall (m :: * -> *). Monad m => [Char] -> Cmd m Nick
readNick [Char]
nick
          changeKarma dk sender nick' >>= say

------------------------------------------------------------------------

tellKarma :: Nick -> E.Polynick -> Cmd Karma ()
tellKarma :: Nick -> Polynick -> Cmd Karma ()
tellKarma Nick
sender Polynick
nick = do
    lookup' <- LB (Polynick -> KarmaState -> [(Nick, Integer)])
-> Cmd Karma (Polynick -> KarmaState -> [(Nick, Integer)])
forall a. LB a -> Cmd Karma a
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
    karma <- (sum . map snd . lookup' nick) `fmap` readMS
    nickStr <- withMsg (return . flip E.showPolynick nick)
    say $ concat [if E.mononickToPolynick sender == nick then "You have" else nickStr ++ " has"
                   ," a karma of "
                   ,show karma]

listKarma :: Cmd Karma ()
listKarma :: Cmd Karma ()
listKarma = do
    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 a b. (a -> b) -> Cmd Karma a -> Cmd Karma b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Cmd Karma KarmaState
Cmd Karma (LBState (Cmd Karma))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    let 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
    flip mapM_ ks' $ \(Nick
k,Integer
e) -> do
        k' <- Nick -> Cmd Karma [Char]
forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
k
        say (printf " %-20s %4d" k' 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
        me <- Cmd Karma Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
        changeKarma (-km) me sender
    | Nick
sender Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
nick = [Char] -> Cmd Karma [Char]
forall a. a -> Cmd Karma a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"You can't change your own karma, silly."
    | Bool
otherwise      = do
        nickStr <- Nick -> Cmd Karma [Char]
forall (m :: * -> *). Monad m => Nick -> Cmd m [Char]
showNick Nick
nick
        withMS $ \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 a. a -> Cmd Karma a
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]
"."