-- | 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 (ModuleT KarmaState LB)]
moduleCmds = [Command (ModuleT KarmaState LB)]
-> ModuleT KarmaState LB [Command (ModuleT KarmaState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"karma")
            { help :: Cmd (ModuleT KarmaState LB) ()
help = String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"karma <polynick>. Return a person's karma value"
            , process :: String -> Cmd (ModuleT KarmaState LB) ()
process = \String
rest -> (forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
 -> Cmd (ModuleT KarmaState LB) ())
-> (forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall a b. (a -> b) -> a -> b
$ \a
msg -> do
                Nick
sender <- Cmd (ModuleT KarmaState LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Nick -> Polynick -> Cmd (ModuleT KarmaState LB) ()
tellKarma Nick
sender (Polynick -> Cmd (ModuleT KarmaState LB) ())
-> Polynick -> Cmd (ModuleT KarmaState LB) ()
forall a b. (a -> b) -> a -> b
$ case String -> [String]
words String
rest of
                    []       -> Nick -> Polynick
E.mononickToPolynick Nick
sender
                    (String
nick:[String]
_) -> a -> String -> Polynick
forall a. Message a => a -> String -> Polynick
E.readPolynick a
msg String
nick

            }
        , (String -> Command Identity
command String
"karma+")
            { help :: Cmd (ModuleT KarmaState LB) ()
help = String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"karma+ <nick>. Increment someone's karma"
            , process :: String -> Cmd (ModuleT KarmaState LB) ()
process = Integer -> String -> Cmd (ModuleT KarmaState LB) ()
doCmd Integer
1
            }
        , (String -> Command Identity
command String
"karma-")
            { help :: Cmd (ModuleT KarmaState LB) ()
help = String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"karma- <nick>. Decrement someone's karma"
            , process :: String -> Cmd (ModuleT KarmaState LB) ()
process = Integer -> String -> Cmd (ModuleT KarmaState LB) ()
doCmd (-Integer
1)
            }
        , (String -> Command Identity
command String
"karma-all")
            { help :: Cmd (ModuleT KarmaState LB) ()
help = String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"karma-all. List all karma"
            , process :: String -> Cmd (ModuleT KarmaState LB) ()
process = Cmd (ModuleT KarmaState LB) ()
-> String -> Cmd (ModuleT KarmaState LB) ()
forall a b. a -> b -> a
const Cmd (ModuleT KarmaState LB) ()
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 :: String -> Cmd (ModuleT KarmaState LB) ()
contextual = \String
text -> (forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
 -> Cmd (ModuleT KarmaState LB) ())
-> (forall a. Message a => a -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
        Nick
sender <- Cmd (ModuleT KarmaState LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender

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

        (Nick -> Cmd (ModuleT KarmaState LB) String)
-> [Nick] -> Cmd (ModuleT KarmaState LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer -> Nick -> Nick -> Cmd (ModuleT KarmaState LB) String
changeKarma (-Integer
1) Nick
sender) ([Nick] -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) [Nick]
-> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT KarmaState LB) [Nick]
decs
        (Nick -> Cmd (ModuleT KarmaState LB) String)
-> [Nick] -> Cmd (ModuleT KarmaState LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer -> Nick -> Nick -> Cmd (ModuleT KarmaState LB) String
changeKarma   Integer
1  Nick
sender) ([Nick] -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) [Nick]
-> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT KarmaState LB) [Nick]
incs
    }

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

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

tellKarma :: Nick -> E.Polynick -> Cmd Karma ()
tellKarma :: Nick -> Polynick -> Cmd (ModuleT KarmaState LB) ()
tellKarma Nick
sender Polynick
nick = do
    Polynick -> KarmaState -> [(Nick, Integer)]
lookup' <- LB (Polynick -> KarmaState -> [(Nick, Integer)])
-> Cmd
     (ModuleT KarmaState LB)
     (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 (ModuleT KarmaState LB) KarmaState
-> Cmd (ModuleT KarmaState LB) Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Cmd (ModuleT KarmaState LB) KarmaState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    String
nickStr <- (forall a. Message a => a -> Cmd (ModuleT KarmaState LB) String)
-> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (String -> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT KarmaState LB) String)
-> (a -> String) -> a -> Cmd (ModuleT KarmaState LB) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Polynick -> String) -> Polynick -> a -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Polynick -> String
forall a. Message a => a -> Polynick -> String
E.showPolynick Polynick
nick)
    String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT KarmaState LB) ())
-> String -> Cmd (ModuleT KarmaState LB) ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
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 String
"You have" else String
nickStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has"
                   ,String
" a karma of "
                   ,Integer -> String
forall a. Show a => a -> String
show Integer
karma]

listKarma :: Cmd Karma ()
listKarma :: Cmd (ModuleT KarmaState LB) ()
listKarma = do
    [(Nick, Integer)]
ks <- KarmaState -> [(Nick, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (KarmaState -> [(Nick, Integer)])
-> Cmd (ModuleT KarmaState LB) KarmaState
-> Cmd (ModuleT KarmaState LB) [(Nick, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Cmd (ModuleT KarmaState LB) 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 (ModuleT KarmaState LB) ())
 -> [(Nick, Integer)] -> Cmd (ModuleT KarmaState LB) ())
-> [(Nick, Integer)]
-> ((Nick, Integer) -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Nick, Integer) -> Cmd (ModuleT KarmaState LB) ())
-> [(Nick, Integer)] -> Cmd (ModuleT KarmaState LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [(Nick, Integer)]
ks' (((Nick, Integer) -> Cmd (ModuleT KarmaState LB) ())
 -> Cmd (ModuleT KarmaState LB) ())
-> ((Nick, Integer) -> Cmd (ModuleT KarmaState LB) ())
-> Cmd (ModuleT KarmaState LB) ()
forall a b. (a -> b) -> a -> b
$ \(Nick
k,Integer
e) -> do
        String
k' <- Nick -> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
k
        String -> Cmd (ModuleT KarmaState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
" %-20s %4d" String
k' Integer
e)

changeKarma :: Integer -> Nick -> Nick -> Cmd Karma String
changeKarma :: Integer -> Nick -> Nick -> Cmd (ModuleT KarmaState LB) String
changeKarma Integer
km Nick
sender Nick
nick
    | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Nick -> String
nName Nick
nick) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"java" Bool -> Bool -> Bool
&& Integer
km Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = do
        Nick
me <- Cmd (ModuleT KarmaState LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
        Integer -> Nick -> Nick -> Cmd (ModuleT KarmaState LB) String
changeKarma (-Integer
km) Nick
me Nick
sender
    | Nick
sender Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
nick = String -> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"You can't change your own karma, silly."
    | Bool
otherwise      = do
        String
nickStr <- Nick -> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
nick
        (LBState (Cmd (ModuleT KarmaState LB))
 -> (LBState (Cmd (ModuleT KarmaState LB))
     -> Cmd (ModuleT KarmaState LB) ())
 -> Cmd (ModuleT KarmaState LB) String)
-> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd (ModuleT KarmaState LB))
  -> (LBState (Cmd (ModuleT KarmaState LB))
      -> Cmd (ModuleT KarmaState LB) ())
  -> Cmd (ModuleT KarmaState LB) String)
 -> Cmd (ModuleT KarmaState LB) String)
-> (LBState (Cmd (ModuleT KarmaState LB))
    -> (LBState (Cmd (ModuleT KarmaState LB))
        -> Cmd (ModuleT KarmaState LB) ())
    -> Cmd (ModuleT KarmaState LB) String)
-> Cmd (ModuleT KarmaState LB) String
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT KarmaState LB))
fm LBState (Cmd (ModuleT KarmaState LB))
-> Cmd (ModuleT KarmaState LB) ()
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 (ModuleT KarmaState LB))
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 (ModuleT KarmaState LB))
-> Cmd (ModuleT KarmaState LB) ()
write KarmaState
LBState (Cmd (ModuleT KarmaState LB))
fm'
            String -> Cmd (ModuleT KarmaState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Integer -> String -> String
forall a. (Ord a, Num a) => String -> a -> String -> String
fmt String
nickStr Integer
km (Integer -> String
forall a. Show a => a -> String
show Integer
karma))
        where
            fmt :: String -> a -> String -> String
fmt String
n a
v String
k | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s karma lowered to "    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                      | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s karma unchanged at "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                      | Bool
otherwise = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s karma raised to "     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."