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
    ( remember
    , quote
    , reportHistory
    )
where

import Control.Monad (liftM, unless)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (find, mapM_)
import Data.Monoid ((<>))
import Data.Sequence ((|>), Seq, ViewL (..))
import FunBot.Config (maxHistoryLines, quoteDir)
import FunBot.Types
import FunBot.Util (getTimeStr)
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.State
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

tailQ :: Seq a -> Seq a
tailQ s =
    case Q.viewl s of
        EmptyL -> s
        _ :< t -> t

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

-- | Remember someone said something, for use later when quoting.
remember :: String -- ^ Channel
         -> String -- ^ User nickname
         -> String -- ^ Message
         -> Bool   -- ^ Whether a /me action (True) or regular message (False)
         -> BotSession ()
remember chan nick msg action = do
    h <- getStateS bsHistory
    t <- getTimeStr
    let hl = HistoryLine
            { hlTime    = t
            , hlNick    = nick
            , hlMessage = msg
            , hlAction  = action
            }
        shorten s = if Q.length s > maxHistoryLines then tailQ s else s
        hls' = case M.lookup chan h of
            Just hls -> shorten $ hls |> hl
            Nothing  -> Q.singleton hl
    modifyState $ \ s -> s { bsHistory = M.insert chan hls' h }

-- | Record someone's last message as a quote.
quote :: String --
      -> String --
      -> BotSession ()
quote chan nick = do
    history <- getStateS bsHistory
    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
    mhls <- liftM (M.lookup chan) $ getStateS bsHistory
    case mhls of
        Nothing     -> return ()
        Just hlsAll -> do
            let lAll = Q.length hlsAll
                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