-- | 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 = 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

    -- nick++($| )
    , 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)
            -- 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]
"%"]

        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]
"."