-- | 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 ActivityState
activityPlugin = forall st. Module st
newModule
    { moduleDefState :: LB ActivityState
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return []
    , moduleInit :: ModuleT ActivityState LB ()
moduleInit = forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter Nick -> [String] -> Activity [String]
activityFilter

    , moduleCmds :: ModuleT ActivityState LB [Command (ModuleT ActivityState LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"activity")
            { help :: Cmd (ModuleT ActivityState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , process :: String -> Cmd (ModuleT ActivityState LB) ()
process = Bool -> String -> Cmd (ModuleT ActivityState LB) ()
activity Bool
False
            }
        , (String -> Command Identity
command String
"activity-full")
            { help :: Cmd (ModuleT ActivityState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , privileged :: Bool
privileged = Bool
True
            , process :: String -> Cmd (ModuleT ActivityState LB) ()
process = Bool -> String -> Cmd (ModuleT ActivityState 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 ActivityState LB) ()
activity Bool
full String
args = do
    let obscure :: Nick -> Cmd m Nick
obscure Nick
nm
            | Bool
full Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"#" (Nick -> String
nName Nick
nm) = forall (m :: * -> *) a. Monad m => a -> m a
return Nick
nm
            | Bool
otherwise = forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
"private"

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

    forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
fmt_agg

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