From 705e49109b7954dbbe7227d721cb58a5824c6bab Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Mon, 22 Jun 2026 19:31:21 +0100 Subject: [PATCH 1/2] introduce quote biasing --- src/Tablebot/Plugins/Quote.hs | 45 ++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index a84da78..a4784e5 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -13,13 +13,15 @@ -- quotes and then @!quote show n@ a particular quote. module Tablebot.Plugins.Quote (quotes) where -import Control.Monad (join) -import Control.Monad.IO.Class (liftIO) +import Control.Monad.Exception (MonadException) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson import Data.Default (Default (def)) import Data.Functor ((<&>)) -import Data.Maybe (catMaybes, fromMaybe, listToMaybe) +import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text, append, pack, unpack) +import Data.Time (getCurrentTime) +import Data.Time.Calendar (Year, periodFromDay, periodToDay) import Data.Time.Clock.System (SystemTime (systemSeconds), getSystemTime, systemToUTCTime) import Data.Word import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, fromSqlKey, toSqlKey, (==.)) @@ -31,7 +33,7 @@ import qualified Discord.Internal.Rest.Interactions as R import Discord.Types import GHC.Generics (Generic) import GHC.Int (Int64) -import System.Random (randomRIO) +import System.Random (randomIO, randomRIO) import Tablebot.Utility import Tablebot.Utility.Discord ( getMessage, @@ -212,22 +214,37 @@ filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuot catchBot' (GenericException "quote exception" _) = return $ (messageDetailsBasic errorMessage) {messageDetailsEmbeds = Just [], messageDetailsComponents = Just []} catchBot' e = throwBot e --- | @filteredRandomQuote'@ selects a random quote that meets a --- given criteria, and returns that as the response, throwing an exception if something --- goes wrong. -filteredRandomQuote' :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails -filteredRandomQuote' quoteFilter errorMessage mb m = do - num <- liftSql $ Sql.count quoteFilter +-- | Get a random quote fitting the filter, preferring more recent quotes. +-- +-- Throws exceptions if we can't find any quotes and if we can't find the selected +-- quote. +filteredRandomQuoteDb :: (MonadException m, MonadIO m) => [Filter Quote] -> Text -> Sql.SqlPersistT m (Entity Quote) +filteredRandomQuoteDb quoteFilter errorMessage = do + now <- liftIO getCurrentTime + let day = utctDay now + (year :: Year, dayOfYear) = periodFromDay day + onlyLastThreeYears :: Bool <- randomIO + let qFilter = + quoteFilter + <> [QuoteTime Sql.>=. UTCTime (periodToDay (year - 3) dayOfYear) 0 | onlyLastThreeYears] + num <- Sql.count qFilter if num == 0 -- we can't find any quotes meeting the filter then throwBot (GenericException "quote exception" (unpack errorMessage)) else do rindex <- liftIO $ randomRIO (0, num - 1) - keys <- liftSql $ Sql.selectKeysList quoteFilter [OffsetBy rindex, LimitTo 1] - qu <- traverse (\key -> fmap (,key) <$> liftSql (Sql.get key)) $ listToMaybe keys - case join qu of - Just (q, key) -> renderQuoteMessage q (fromSqlKey key) mb m + quoteM <- Sql.selectFirst qFilter [OffsetBy rindex, LimitTo 1] + case quoteM of + Just e -> pure e Nothing -> throwBot (GenericException "quote exception" (unpack errorMessage)) +-- | @filteredRandomQuote'@ selects a random quote that meets a +-- given criteria, and returns that as the response, throwing an exception if something +-- goes wrong. +filteredRandomQuote' :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails +filteredRandomQuote' quoteFilter errorMessage mb m = do + Sql.Entity key q <- liftSql $ filteredRandomQuoteDb quoteFilter errorMessage + renderQuoteMessage q (fromSqlKey key) mb m + -- | @addQuote@, which looks for a message of the form -- @!quote add "quoted text" - author@, and then stores said quote in the -- database, returning the ID used. From 21b068de6d49632ae537eea2f19cdbf4bff8adfd Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Mon, 22 Jun 2026 19:34:52 +0100 Subject: [PATCH 2/2] only apply timing filter if not quoting by author --- src/Tablebot/Plugins/Quote.hs | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index a4784e5..f337195 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -24,7 +24,7 @@ import Data.Time (getCurrentTime) import Data.Time.Calendar (Year, periodFromDay, periodToDay) import Data.Time.Clock.System (SystemTime (systemSeconds), getSystemTime, systemToUTCTime) import Data.Word -import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, fromSqlKey, toSqlKey, (==.)) +import Database.Persist.Sqlite (Entity (entityKey), SelectOpt (LimitTo, OffsetBy), entityVal, fromSqlKey, toSqlKey, (==.)) import qualified Database.Persist.Sqlite as Sql import Database.Persist.TH import Discord (restCall) @@ -185,10 +185,14 @@ showQ qId m = do Just q -> renderQuoteMessage q qId Nothing m Nothing -> return $ messageDetailsBasic "Couldn't get that quote!" +data QuoteFilter + = AnyQuote + | AuthoredBy Text + -- | @randomQuote@, which looks for a message of the form @!quote random@, -- selects a random quote from the database and responds with that quote. randomQ :: (Context m) => m -> DatabaseDiscord MessageDetails -randomQ = filteredRandomQuote [] "Couldn't find any quotes!" (Just randomButton) +randomQ = filteredRandomQuote AnyQuote "Couldn't find any quotes!" (Just randomButton) where randomButton = mkButton "Random quote" "quote random" @@ -198,7 +202,7 @@ randomQuoteComponentRecv = ComponentRecv "random" (processComponentInteraction ( -- | @authorQuote@, which looks for a message of the form @!quote author u@, -- selects a random quote from the database attributed to u and responds with that quote. authorQ :: (Context m) => Text -> m -> DatabaseDiscord MessageDetails -authorQ t = filteredRandomQuote [QuoteAuthor ==. t] "Couldn't find any quotes with that author!" (Just authorButton) +authorQ t = filteredRandomQuote (AuthoredBy t) "Couldn't find any quotes with that author!" (Just authorButton) where authorButton = mkButton "Random author quote" ("quote author " <> t) @@ -208,7 +212,7 @@ authorQuoteComponentRecv = ComponentRecv "author" (processComponentInteraction ( -- | @filteredRandomQuote@ selects a random quote that meets a -- given criteria, and returns that as the response, sending the user a message if the -- quote cannot be found. -filteredRandomQuote :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails +filteredRandomQuote :: (Context m) => QuoteFilter -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuote' quoteFilter errorMessage mb m) catchBot' where catchBot' (GenericException "quote exception" _) = return $ (messageDetailsBasic errorMessage) {messageDetailsEmbeds = Just [], messageDetailsComponents = Just []} @@ -218,15 +222,17 @@ filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuot -- -- Throws exceptions if we can't find any quotes and if we can't find the selected -- quote. -filteredRandomQuoteDb :: (MonadException m, MonadIO m) => [Filter Quote] -> Text -> Sql.SqlPersistT m (Entity Quote) +filteredRandomQuoteDb :: (MonadException m, MonadIO m) => QuoteFilter -> Text -> Sql.SqlPersistT m (Entity Quote) filteredRandomQuoteDb quoteFilter errorMessage = do now <- liftIO getCurrentTime let day = utctDay now (year :: Year, dayOfYear) = periodFromDay day onlyLastThreeYears :: Bool <- randomIO - let qFilter = - quoteFilter - <> [QuoteTime Sql.>=. UTCTime (periodToDay (year - 3) dayOfYear) 0 | onlyLastThreeYears] + let qFilter = case quoteFilter of + AnyQuote -> + [QuoteTime Sql.>=. UTCTime (periodToDay (year - 3) dayOfYear) 0 | onlyLastThreeYears] + AuthoredBy author -> + [QuoteAuthor ==. author] num <- Sql.count qFilter if num == 0 -- we can't find any quotes meeting the filter then throwBot (GenericException "quote exception" (unpack errorMessage)) @@ -240,7 +246,7 @@ filteredRandomQuoteDb quoteFilter errorMessage = do -- | @filteredRandomQuote'@ selects a random quote that meets a -- given criteria, and returns that as the response, throwing an exception if something -- goes wrong. -filteredRandomQuote' :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails +filteredRandomQuote' :: (Context m) => QuoteFilter -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails filteredRandomQuote' quoteFilter errorMessage mb m = do Sql.Entity key q <- liftSql $ filteredRandomQuoteDb quoteFilter errorMessage renderQuoteMessage q (fromSqlKey key) mb m