{- This file is part of funbot. - - Written in 2015 by fr33domlover . - - ♡ 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 - . -} -- 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