History.hs

{- This file is part of funbot.
 -
 - Written in 2015 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 (find, mapM_)
import Data.Int (Int64)
import Data.Monoid ((<>))
import Data.Sequence ((|>), Seq, ViewL (..))
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 (HistoryLine (..))
import Network.IRC.Fun.Color
import Prelude hiding (mapM_)
import System.IO
import Text.Printf (printf)

import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q

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

formatLine :: HistoryLine -> String
formatLine hl =
    let time = Purple #> Pure (hlTime hl ++ " UTC")
        sender =
            if hlAction hl
                    then
                        "* " <> Green #> Pure (hlNick hl)
                    else
                        Gray #> "<" <> Green #> Pure (hlNick hl) <> Gray #> ">"
        content = Pure $ hlMessage hl
    in  encode $ time <> " " <> sender <> " " <> content

-- | Record someone's last message as a quote.
quote :: String --
      -> String --
      -> 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." ++ chan
            liftIO $ withFile file AppendMode $ \ h -> do
                hPutChar h '\n'
                hPutStrLn h $ hlTime hl
                hPutStrLn h nick
                hPutStrLn h $ hlMessage hl
            sendToChannel chan "Quote logged."
        Nothing -> sendToChannel chan "No recent messages by that user."

-- Send last channel messages to a user, for a specific channel.
reportHistory :: String -- ^ User nickname
              -> String -- ^ Channel
              -> Int    -- ^ Maximal number of messages to send
              -> BotSession ()
reportHistory recip chan maxlen = do
    c <- chanIsCounted chan
    missed <-
        if c
            then do
                res <- msgsSinceParted recip chan
                case res of
                    Left n  -> do
                        sendToUser recip $
                            printf
                                "You missed at least %v messages in %v."
                                n
                                chan
                        return Nothing
                    Right n -> do
                        sendToUser recip $
                            if n == 0
                                then printf
                                        "You didn't miss any messages in %v."
                                        chan
                                else printf
                                        "You missed %v messages in %v."
                                        n
                                        chan
                        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
                sendToUser recip $ printf "Last %v messages in %v:" l chan
                mapM_ (sendToUser recip . formatLine) hls

-- Send recent channel messages to a user, for a specific channel.
reportHistory' :: String -- ^ User nickname
               -> String -- ^ 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 "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 $
                            printf "No messages in last %v minutes." mins
                    else do
                        sendToUser recip $
                            printf
                                "Messages I remember from last %v minutes in \
                                \%v:"
                                mins chan
                        mapM_ (sendToUser recip . formatLine) hls