-- | Logging an IRC channel..
module Lambdabot.Plugin.Social.Activity (activityPlugin) where

import Lambdabot.Monad
import Lambdabot.Plugin
import Lambdabot.Util

import Control.Arrow ((&&&))
import Control.Exception (evaluate)
import Data.List
import Data.Maybe
import Data.Time

type ActivityState = [(UTCTime,Nick)]
type Activity       = ModuleT ActivityState LB

activityPlugin :: Module [(UTCTime, Nick)]
activityPlugin :: Module [(UTCTime, Nick)]
activityPlugin = Module [(UTCTime, Nick)]
forall st. Module st
newModule
    { moduleDefState :: LB [(UTCTime, Nick)]
moduleDefState = [(UTCTime, Nick)] -> LB [(UTCTime, Nick)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    , moduleInit :: ModuleT [(UTCTime, Nick)] LB ()
moduleInit = OutputFilter [(UTCTime, Nick)] -> ModuleT [(UTCTime, Nick)] LB ()
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter OutputFilter [(UTCTime, Nick)]
activityFilter

    , moduleCmds :: ModuleT
  [(UTCTime, Nick)] LB [Command (ModuleT [(UTCTime, Nick)] LB)]
moduleCmds = [Command (ModuleT [(UTCTime, Nick)] LB)]
-> ModuleT
     [(UTCTime, Nick)] LB [Command (ModuleT [(UTCTime, Nick)] LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"activity")
            { help :: Cmd (ModuleT [(UTCTime, Nick)] LB) ()
help = String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , process :: String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
process = Bool -> String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
activity Bool
False
            }
        , (String -> Command Identity
command String
"activity-full")
            { help :: Cmd (ModuleT [(UTCTime, Nick)] LB) ()
help = String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , privileged :: Bool
privileged = Bool
True
            , process :: String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
process = Bool -> String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
activity Bool
True
            }
        ]
    }

helpStr :: String
helpStr :: String
helpStr = String
"activity seconds. Find out where/how much the bot is being used"

activity :: Bool -> String -> Cmd Activity ()
activity :: Bool -> String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
activity Bool
full String
args = do
    let obscure :: Nick -> Cmd m Nick
obscure Nick
nm
            | Bool
full Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"#" (Nick -> String
nName Nick
nm) = Nick -> Cmd m Nick
forall (m :: * -> *) a. Monad m => a -> m a
return Nick
nm
            | Bool
otherwise = String -> Cmd m Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
"private"

    UTCTime
now <- IO UTCTime -> Cmd (ModuleT [(UTCTime, Nick)] LB) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
    let cutoff :: UTCTime
cutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (- Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
90 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
args)) UTCTime
now
    [Nick]
users <- ((UTCTime, Nick) -> Cmd (ModuleT [(UTCTime, Nick)] LB) Nick)
-> [(UTCTime, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [Nick]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Nick -> Cmd (ModuleT [(UTCTime, Nick)] LB) Nick
forall (m :: * -> *). Monad m => Nick -> Cmd m Nick
obscure (Nick -> Cmd (ModuleT [(UTCTime, Nick)] LB) Nick)
-> ((UTCTime, Nick) -> Nick)
-> (UTCTime, Nick)
-> Cmd (ModuleT [(UTCTime, Nick)] LB) Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime, Nick) -> Nick
forall a b. (a, b) -> b
snd) ([(UTCTime, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [Nick])
-> ([(UTCTime, Nick)] -> [(UTCTime, Nick)])
-> [(UTCTime, Nick)]
-> Cmd (ModuleT [(UTCTime, Nick)] LB) [Nick]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UTCTime, Nick) -> Bool) -> [(UTCTime, Nick)] -> [(UTCTime, Nick)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
cutoff) (UTCTime -> Bool)
-> ((UTCTime, Nick) -> UTCTime) -> (UTCTime, Nick) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime, Nick) -> UTCTime
forall a b. (a, b) -> a
fst) ([(UTCTime, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [Nick])
-> Cmd (ModuleT [(UTCTime, Nick)] LB) [(UTCTime, Nick)]
-> Cmd (ModuleT [(UTCTime, Nick)] LB) [Nick]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT [(UTCTime, Nick)] LB) [(UTCTime, Nick)]
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    let agg_users :: [(Int, Nick)]
agg_users = [(Int, Nick)] -> [(Int, Nick)]
forall a. [a] -> [a]
reverse ([(Int, Nick)] -> [(Int, Nick)])
-> ([Nick] -> [(Int, Nick)]) -> [Nick] -> [(Int, Nick)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Nick)] -> [(Int, Nick)]
forall a. Ord a => [a] -> [a]
sort ([(Int, Nick)] -> [(Int, Nick)])
-> ([Nick] -> [(Int, Nick)]) -> [Nick] -> [(Int, Nick)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Nick] -> (Int, Nick)) -> [[Nick]] -> [(Int, Nick)]
forall a b. (a -> b) -> [a] -> [b]
map ([Nick] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Nick] -> Int) -> ([Nick] -> Nick) -> [Nick] -> (Int, Nick)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Nick] -> Nick
forall a. [a] -> a
head) ([[Nick]] -> [(Int, Nick)])
-> ([Nick] -> [[Nick]]) -> [Nick] -> [(Int, Nick)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Nick] -> [[Nick]]
forall a. Eq a => [a] -> [[a]]
group ([Nick] -> [[Nick]]) -> ([Nick] -> [Nick]) -> [Nick] -> [[Nick]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Nick] -> [Nick]
forall a. Ord a => [a] -> [a]
sort ([Nick] -> [(Int, Nick)]) -> [Nick] -> [(Int, Nick)]
forall a b. (a -> b) -> a -> b
$ [Nick]
users
    String
fmt_agg <- ([String] -> String)
-> Cmd (ModuleT [(UTCTime, Nick)] LB) [String]
-> Cmd (ModuleT [(UTCTime, Nick)] LB) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Int -> String
forall a. Show a => a -> String
show ([Nick] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Nick]
users) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*total"))
                    (((Int, Nick) -> Cmd (ModuleT [(UTCTime, Nick)] LB) String)
-> [(Int, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
n,Nick
u) -> do String
u' <- Nick -> Cmd (ModuleT [(UTCTime, Nick)] LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
u; String -> Cmd (ModuleT [(UTCTime, Nick)] LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u')) ([(Int, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [String])
-> [(Int, Nick)] -> Cmd (ModuleT [(UTCTime, Nick)] LB) [String]
forall a b. (a -> b) -> a -> b
$ [(Int, Nick)]
agg_users)

    String -> Cmd (ModuleT [(UTCTime, Nick)] LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
fmt_agg

activityFilter :: Nick -> [String] -> Activity [String]
activityFilter :: OutputFilter [(UTCTime, Nick)]
activityFilter Nick
target [String]
lns = do
    IO () -> ModuleT [(UTCTime, Nick)] LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ModuleT [(UTCTime, Nick)] LB ())
-> IO () -> ModuleT [(UTCTime, Nick)] LB ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ (() -> () -> ()) -> () -> [()] -> ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr () -> () -> ()
seq () ([()] -> ()) -> [()] -> ()
forall a b. (a -> b) -> a -> b
$ (String -> ()) -> [String] -> [()]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> () -> ()) -> () -> String -> ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> () -> ()
seq ()) ([String] -> [()]) -> [String] -> [()]
forall a b. (a -> b) -> a -> b
$ [String]
lns
    (LBState (ModuleT [(UTCTime, Nick)] LB)
 -> (LBState (ModuleT [(UTCTime, Nick)] LB)
     -> ModuleT [(UTCTime, Nick)] LB ())
 -> ModuleT [(UTCTime, Nick)] LB ())
-> ModuleT [(UTCTime, Nick)] LB ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (ModuleT [(UTCTime, Nick)] LB)
  -> (LBState (ModuleT [(UTCTime, Nick)] LB)
      -> ModuleT [(UTCTime, Nick)] LB ())
  -> ModuleT [(UTCTime, Nick)] LB ())
 -> ModuleT [(UTCTime, Nick)] LB ())
-> (LBState (ModuleT [(UTCTime, Nick)] LB)
    -> (LBState (ModuleT [(UTCTime, Nick)] LB)
        -> ModuleT [(UTCTime, Nick)] LB ())
    -> ModuleT [(UTCTime, Nick)] LB ())
-> ModuleT [(UTCTime, Nick)] LB ()
forall a b. (a -> b) -> a -> b
$ \ LBState (ModuleT [(UTCTime, Nick)] LB)
st LBState (ModuleT [(UTCTime, Nick)] LB)
-> ModuleT [(UTCTime, Nick)] LB ()
wr -> do
        UTCTime
now <- IO UTCTime -> ModuleT [(UTCTime, Nick)] LB UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
        LBState (ModuleT [(UTCTime, Nick)] LB)
-> ModuleT [(UTCTime, Nick)] LB ()
wr ((String -> (UTCTime, Nick)) -> [String] -> [(UTCTime, Nick)]
forall a b. (a -> b) -> [a] -> [b]
map ((UTCTime, Nick) -> String -> (UTCTime, Nick)
forall a b. a -> b -> a
const (UTCTime
now,Nick
target)) [String]
lns [(UTCTime, Nick)] -> [(UTCTime, Nick)] -> [(UTCTime, Nick)]
forall a. [a] -> [a] -> [a]
++ [(UTCTime, Nick)]
LBState (ModuleT [(UTCTime, Nick)] LB)
st)
    [String] -> Activity [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
lns