History.hs

{- This file is part of funbot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- For irc-fun-color StyledString
{-# LANGUAGE OverloadedStrings #-}

module FunBot.History
    ( quote
    , reportHistory
    , reportHistory'
    )
where

import Control.Monad (liftM, unless, when)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable
import Data.Traversable (for)
import Data.Int (Int64)
import Data.Monoid ((<>))
import Data.Sequence ((|>), Seq, ViewL (..), ViewR (..))
import Data.Text (Text)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Formatting ((%), int)
import FunBot.Config (quoteDir)
import FunBot.Types
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.MsgCount
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Bot.Types
import Network.IRC.Fun.Color
import Network.IRC.Fun.Types.Base
import Prelude hiding (mapM_)
import System.IO
import Text.Printf (printf)

import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

findLast :: (a -> Bool) -> Seq a -> Maybe a
findLast p s = fmap (Q.index s) $ Q.findIndexR p s

formatLine :: HistoryLine -> MsgContent
formatLine hl =
    let time = Purple #> plain (hlTime hl <> " UTC")
        nick = unNickname $ hlNick hl
        sender =
            if hlAction hl
                    then
                        "* " <> Green #> plain nick
                    else
                        Gray #> "<" <> Green #> plain nick <> Gray #> ">"
        content = plain $ unMsgContent $ hlMessage hl
    in  MsgContent $ encode $ time <> " " <> sender <> " " <> content

timeParted :: Channel -> Nickname -> BotSession (Maybe UTCTime)
timeParted chan nick = fmap f $ getCountLog chan
    where
    f q = case Q.viewr q of
            EmptyR                  -> Nothing
            r :> (MsgCountPart n t) -> if n == nick then Just t else f r
            r :> _                  -> f r

urlQuery :: UTCTime -> Text
urlQuery t =
    let stamp = floor $ utcTimeToPOSIXSeconds t
    in  format ("?timestamp=" % int % "#t" % int) stamp stamp

browseUrl :: Channel -> Nickname -> BotSession (Maybe Text)
browseUrl chan nick = do
    mcs <- getStateS $ M.lookup chan . stChannels . bsSettings
    let mbrowse = mcs >>= csBrowse
        getQuery = fmap urlQuery <$> timeParted chan nick
    for mbrowse $ \ b -> maybe b (b <>) <$> getQuery

-- | Record someone's last message as a quote.
quote :: Channel -> Nickname -> BotSession ()
quote chan nick = do
    history <- getHistory
    let sameNick hl = hlNick hl == nick
    case M.lookup chan history >>= findLast sameNick of
        Just hl -> do
            let file = quoteDir ++ "/server." ++ (T.unpack $ unChannel chan)
            liftIO $ withFile file AppendMode $ \ h -> do
                hPutChar h '\n'
                TIO.hPutStrLn h $ hlTime hl
                TIO.hPutStrLn h $ unNickname nick
                TIO.hPutStrLn h $ unMsgContent $ hlMessage hl
            sendToChannel chan $ MsgContent "Quote logged."
        Nothing ->
            sendToChannel chan $ MsgContent "No recent messages by that user."

-- Send last channel messages to a user, for a specific channel.
reportHistory
    :: Nickname -- ^ User nickname
    -> Channel  -- ^ Channel
    -> Int      -- ^ Maximal number of messages to send
    -> Bool     -- ^ Whether send notice instead of regular privmsg
    -> BotSession ()
reportHistory recip chan maxlen notice = do
    let send = sendToUser' notice
    c <- chanIsCounted chan
    missed <-
        if c
            then do
                res <- msgsSinceParted recip chan
                murl <- browseUrl chan recip
                case res of
                    Left n  -> do
                        send recip $
                            formatMsg
                                ("You missed at least " % int % " messages in "
                                % channel % "."
                                )
                                n chan
                        for_ murl $ send recip . MsgContent
                        return Nothing
                    Right n -> do
                        if n == 0
                            then send recip $
                                    formatMsg
                                        ("You didn't miss any messages in "
                                        % channel % "."
                                        )
                                        chan
                            else do
                                send recip $
                                    formatMsg
                                        ("You missed " % int % " messages in "
                                        % channel % "."
                                        )
                                        n chan
                                for_ murl $ send recip . MsgContent
                        return $ Just n
            else return Nothing
    mhls <- liftM (M.lookup chan) getHistory
    case mhls of
        Nothing     -> return ()
        Just hlsAll -> do
            let lAll = Q.length hlsAll
                maxlen' = maybe maxlen (min maxlen) missed
                hls = Q.drop (lAll - maxlen') hlsAll
                l = Q.length hls
            unless (Q.null hls) $ do
                send recip $
                    formatMsg
                        ("Last " % int % " messages in " % channel % ":")
                        l chan
                mapM_ (send recip . formatLine) hls

-- Send recent channel messages to a user, for a specific channel.
reportHistory'
    :: Nickname -- ^ User nickname
    -> Channel  -- ^ Channel
    -> Int64    -- ^ Minutes to go back in history
    -> BotSession ()
reportHistory' recip chan mins = do
    mhls <- liftM (M.lookup chan) getHistory
    case mhls of
        Nothing     ->
            sendToUser recip $ MsgContent
                "No history log found for that channel."
        Just hlsAll -> do
            now <- getMinutes
            let recent hl = now - hlMinute hl <= mins
                hls = Q.takeWhileR recent hlsAll
            if  Q.null hls
                    then sendToUser recip $
                            formatMsg
                                ("No messages in last " % int % " minutes.")
                                mins
                    else do
                        sendToUser recip $
                            formatMsg
                                ("Messages I remember from last " % int
                                % " minutes in " % channel % ":"
                                )
                                mins chan
                        mapM_ (sendToUser recip . formatLine) hls