-- | 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 = Module ActivityState
forall st. Module st
newModule
    { moduleDefState = return []
    , moduleInit = registerOutputFilter activityFilter

    , moduleCmds = return
        [ (command "activity")
            { help = say helpStr
            , process = activity False
            }
        , (command "activity-full")
            { help = say helpStr
            , privileged = True
            , process = activity 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
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"#" (Nick -> String
nName Nick
nm) = Nick -> Cmd m Nick
forall a. a -> Cmd m a
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"

    now <- IO UTCTime -> Cmd (ModuleT ActivityState LB) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
    let 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
    users <- mapM (obscure . snd) . takeWhile ((> cutoff) . fst) =<< readMS
    let 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Nick] -> Int) -> ([Nick] -> Nick) -> [Nick] -> (Int, Nick)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Nick] -> Nick
forall a. HasCallStack => [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
    fmt_agg <- fmap (intercalate " " . (:) (show (length users) ++ "*total"))
                    (mapM (\(Int
n,Nick
u) -> do u' <- Nick -> Cmd (ModuleT ActivityState LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
u; return (show n ++ "*" ++ u')) $ agg_users)

    say fmt_agg

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