-- Copyright (c) 2004 Thomas Jaeger
-- Copyright (c) 2005-6 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | Keep track of IRC users.
module Lambdabot.Plugin.Social.Seen (seenPlugin) where

import Lambdabot.Bot
import Lambdabot.Compat.AltTime
import Lambdabot.Compat.PackedNick
import Lambdabot.IRC
import Lambdabot.Logging
import qualified Lambdabot.Message as G
import Lambdabot.Monad
import Lambdabot.Nick
import Lambdabot.Plugin
import Lambdabot.Util

import Lambdabot.Plugin.Social.Seen.StopWatch
import Lambdabot.Plugin.Social.Seen.UserStatus

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Data.Binary
import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.List
import qualified Data.Map as M
import Text.Printf

type SeenState = (MaxMap, SeenMap)
type SeenMap   = M.Map PackedNick UserStatus
type MaxMap    = M.Map Channel Int

type Seen = ModuleT SeenState LB

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

seenPlugin :: Module (M.Map Channel Int, M.Map PackedNick UserStatus)
seenPlugin = newModule
    { moduleDefState = return (M.empty,M.empty)

    , moduleCmds = return
        [ (command "users")
            { help = say "users [chan]. Report the maximum number of users seen in a channel, and active users in the last 30 minutes"
            , process = doUsers
            }
        , (command "seen")
            { help = say "seen <user>. Report if a user has been seen by the bot"
            , process = doSeen
            }
        ]

    , moduleInit = do
        sequence_
            [ registerCallback signal (withSeenFM cb)
            | (signal, cb) <- zip
                ["JOIN", "PART", "QUIT", "NICK", "353",      "PRIVMSG"]
                [joinCB, partCB, quitCB, nickCB, joinChanCB, msgCB]
            ]

        c <- lb $ findLBFileForReading "seen"
        s <- maybe (return (P.pack "")) (io . P.readFile) c
        let ls = L.fromStrict s
        mbDecoded <- io . try . evaluate $ decode ls
        case mbDecoded of
            Left exc@SomeException{} -> do
                -- try reading the old format (slightly different type... oh, "binary"...)
                mbOld <- io . try . evaluate $ decode ls
                case mbOld of
                    Left SomeException{} ->
                        warningM ("WARNING: failed to read Seen module state: "  ++ show exc)
                    Right (maxMap, seenMap) ->
                        writeMS (M.mapKeys P.pack maxMap, seenMap)
            Right decoded -> writeMS decoded

    , moduleExit = do
        chans <- lift $ ircGetChannels
        unless (null chans) $ do
            ct    <- io getClockTime
            modifyMS $ \(n,m) -> (n, botPart ct (map packNick chans) m)

        -- and write out our state:
        withMS $ \s _ -> lb (findLBFileForWriting "seen") >>= \ c -> io (encodeFile c s)
    }

lcNick :: Nick -> Nick
lcNick (Nick svr nck) = Nick svr (map toLower nck)

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

doUsers :: String -> Cmd Seen ()
doUsers rest = withMsg $ \msg -> do
    -- first step towards tracking the maximum number of users
    chan <- getTarget
    (m, seenFM) <- readMS
    s <- io getClockTime
    let who = packNick $ lcNick $ if null rest then chan else parseNick (G.server msg) rest
        now = length [ () | (_,Present _ chans) <- M.toList seenFM
                          , who `elem` chans ]

        n = case M.lookup who m of Nothing -> 1; Just n' -> n'

        active = length [() | (_,st@(Present _ chans)) <- M.toList seenFM
                            , who `elem` chans && isActive st ]

        isActive (Present (Just (ct,_td)) _cs) = recent ct
        isActive _                             = False

        recent t = diffClockTimes s t < gap_minutes
        gap_minutes = TimeDiff 1800 -- 30 minutes

        percent p q = 100 * (fromIntegral p / fromIntegral q) :: Double

        total   0 0 = "0"
        total   p q = printf "%d (%0.1f%%)" p (percent p q)

    say $! printf "Maximum users seen in %s: %d, currently: %s, active: %s"
        (fmtNick (G.server msg) $ unpackNick who) n (total now n) (total active now)

doSeen :: String -> Cmd Seen ()
doSeen rest = withMsg $ \msg -> do
    target <- getTarget
    (_,seenFM) <- readMS
    now        <- io getClockTime
    let (txt,safe) = (getAnswer msg rest seenFM now)
    if safe || not ("#" `isPrefixOf` nName target)
        then mapM_ say txt
        else lb (ircPrivmsg (G.nick msg) (unlines txt))

getAnswer :: G.Message a => a -> String -> SeenMap -> ClockTime -> ([String], Bool)
getAnswer msg rest seenFM now
    | null nick' =
        let people  = map fst $ filter isActive $ M.toList seenFM
            isActive (_nick,state) = case state of
                (Present (Just (ct,_td)) _cs) -> recent ct
                _ -> False
            recent t = diffClockTimes now t < gap_minutes
            gap_minutes = TimeDiff 900 -- 15 minutes
         in (["Lately, I have seen " ++ (if null people then "nobody"
                 else listToStr "and" (map upAndShow people)) ++ "."], False)

    | pnick == G.lambdabotName msg =
        case M.lookup (packNick pnick) seenFM of
            Just (Present _ cs) ->
                (["Yes, I'm here. I'm in " ++ listToStr "and" (map upAndShow cs)], True)
            _ -> error "I'm here, but not here. And very confused!"

    | head (nName pnick) == '#' =
        let people  = map fst $ filter inChan $ M.toList seenFM
            inChan (_nick,state) = case state of
                (Present (Just _) cs)
                    -> packNick pnick `elem` cs
                _   -> False
         in (["In "++nick'++" I can see "
            ++ (if null people then "nobody"    -- todo, how far back does this go?
               else listToStr "and" (map upAndShow people)) ++ "."], False)

    | otherwise        = (return $ concat (case M.lookup (packNick pnick) seenFM of
        Just (Present mct cs)            -> nickPresent mct (map upAndShow cs)
        Just (NotPresent ct td chans)    -> nickNotPresent ct td (map upAndShow chans)
        Just (WasPresent ct sw _ chans)  -> nickWasPresent ct sw (map upAndShow chans)
        Just (NewNick newnick)           -> nickIsNew newnick
        _ -> ["I haven't seen ", nick, "."]), True)
    where
        -- I guess the only way out of this spagetty hell are printf-style responses.
        upAndShow = fmtNick (G.server msg) . unpackNick
        nickPresent mct cs =
            [ if you then "You are" else nick ++ " is"
            , " in ", listToStr "and" cs, "."
            , case mct of
                Nothing          -> concat [" I don't know when ", nick, " last spoke."]
                Just (ct,missed) -> prettyMissed (Stopped missed)
                       (concat [" I last heard ", nick, " speak ",
                                lastSpoke {-, ", but "-}])
                       (" Last spoke " ++ lastSpoke)
                    where lastSpoke = clockDifference ct
            ]
        nickNotPresent ct missed chans =
            [ "I saw ", nick, " leaving ", listToStr "and" chans, " "
            , clockDifference ct, prettyMissed missed ", and " ""
            ]
        nickWasPresent ct sw chans =
            [ "Last time I saw ", nick, " was when I left "
            , listToStr "and" chans , " ", clockDifference ct
            , prettyMissed sw ", and " ""
            ]
        nickIsNew newnick =
            [ if you then "You have" else nick++" has"
            , " changed nick to ", us, "."
            ] ++ fst (getAnswer msg us seenFM now)
            where
                us = upAndShow $ findFunc newnick
                findFunc pstr = case M.lookup pstr seenFM of
                    Just (NewNick pstr') -> findFunc pstr'
                    Just _               -> pstr
                    Nothing              -> error "SeenModule.nickIsNew: Nothing"

        nick' = takeWhile (not . isSpace) rest
        you   = pnick == lcNick (G.nick msg)
        nick  = if you then "you" else nick'
        pnick = lcNick $ parseNick (G.server msg) nick'
        clockDifference past
            | all (==' ') diff = "just now"
            | otherwise        = diff ++ " ago"
            where diff = timeDiffPretty . diffClockTimes now $ past

        prettyMissed (Stopped _) _ifMissed _     = "." -- ifMissed ++ "."
        prettyMissed _           _ _ifNotMissed  = "." -- ifNotMissed ++ "."

{-
        prettyMissed (Stopped missed) ifMissed _
            | missedPretty <- timeDiffPretty missed
            , any (/=' ') missedPretty
            = concat [ifMissed, "I have missed ", missedPretty, " since then."]

        prettyMissed _ _ ifNotMissed = ifNotMissed ++ "."
-}

-- | extract channels from message as packed, lower cased, strings.
msgChans :: G.Message a => a -> [Channel]
msgChans = map (packNick . lcNick) . G.channels

-- | Callback for when somebody joins. If it is not the bot that joins, record
--   that we have a new user in our state tree and that we have never seen the
--   user speaking.
joinCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
joinCB msg _ct nick fm
    | nick == lbNick = Right fm
    | otherwise      = Right $! insertUpd (updateJ Nothing chans) nick newInfo fm
    where
        insertUpd f = M.insertWith (\_ -> f)
        lbNick  = packNick $ G.lambdabotName msg
        newInfo = Present Nothing chans
        chans   = msgChans msg

-- | Update the state to reflect the bot leaving channel(s)
botPart :: ClockTime -> [Channel] -> SeenMap -> SeenMap
botPart ct cs = fmap botPart'
    where
        botPart' (Present mct xs) = case xs \\ cs of
            [] -> WasPresent ct (startWatch ct zeroWatch) mct cs
            ys -> Present mct ys
        botPart' (NotPresent ct' missed c)
            | head c `elem` cs = NotPresent ct' (startWatch ct missed) c
        botPart' (WasPresent ct' missed mct c)
            | head c `elem` cs = WasPresent ct' (startWatch ct missed) mct c
        botPart' us = us

-- | when somebody parts
partCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
partCB msg ct nick fm
    | nick == lbNick = Right $ botPart ct (msgChans msg) fm
    | otherwise      = case M.lookup nick fm of
        Just (Present mct xs) ->
            case xs \\ (msgChans msg) of
                [] -> Right $! M.insert nick (NotPresent ct zeroWatch xs) fm
                ys -> Right $! M.insert nick (Present mct ys)             fm
        _ -> Left "someone who isn't known parted"
    where lbNick = packNick $ G.lambdabotName msg

-- | when somebody quits
quitCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
quitCB _ ct nick fm = case M.lookup nick fm of
    Just (Present _ct xs) -> Right $! M.insert nick (NotPresent ct zeroWatch xs) fm
    _                     -> Left "someone who isn't known has quit"

-- | when somebody changes his\/her name
nickCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
nickCB msg _ nick fm = case M.lookup nick fm of
    Just status -> Right $! M.insert lcnewnick status
                          $ M.insert nick (NewNick lcnewnick) fm
    _           -> Left "someone who isn't here changed nick"
    where
        newnick = drop 1 $ head (ircMsgParams msg)
        lcnewnick = packNick $ lcNick $ parseNick (G.server msg) newnick

-- | when the bot joins a channel
joinChanCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
joinChanCB msg now _nick fm
    = Right $! fmap (updateNP now chan) (foldl insertNick fm chanUsers)
    where
        l = ircMsgParams msg
        chan = packNick $ lcNick $ parseNick (G.server msg) $ l !! 2
        chanUsers = map (packNick . lcNick . parseNick (G.server msg)) $ words (drop 1 (l !! 3)) -- remove ':'
        unUserMode nick = Nick (nTag nick) (dropWhile (`elem` "@+") $ nName nick)
        insertUpd f = M.insertWith (\_ -> f)
        insertNick fm' u = insertUpd (updateJ (Just now) [chan])
            (packNick . unUserMode . lcNick . unpackNick $ u)
            (Present Nothing [chan]) fm'

-- | when somebody speaks, update their clocktime
msgCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
msgCB _ ct nick fm =
    case M.lookup nick fm of
        Just (Present _ xs) -> Right $!
            M.insert nick (Present (Just (ct, noTimeDiff)) xs) fm
        _ -> Left "someone who isn't here msg us"


-- | Callbacks are only allowed to use a limited knowledge of the world.
-- 'withSeenFM' is (up to trivial isomorphism) a monad morphism from the
-- restricted
--   'ReaderT (IRC.Message, ClockTime, Nick) (StateT SeenState (Error String))'
-- to the
--   'ReaderT IRC.Message (Seen IRC)'
-- monad.
withSeenFM :: G.Message a
           => (a -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap)
           -> (a -> Seen ())

withSeenFM f msg = do
    let chan = packNick . lcNick . head . G.channels $! msg
        nick = packNick . lcNick . G.nick $ msg

    withMS $ \(maxUsers,state) writer -> do
        ct <- io getClockTime
        case f msg ct nick state of
            Left _         -> return ()
            Right newstate -> do
                let curUsers = length $!
                        [ () | (_,Present _ chans) <- M.toList state
                        , chan `elem` chans ]

                    newMax = case M.lookup chan maxUsers of
                        Nothing -> M.insert chan curUsers maxUsers
                        Just  n -> if n < curUsers
                            then M.insert chan curUsers maxUsers
                            else maxUsers

                newMax `seq` newstate `seq` writer (newMax, newstate)