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