Quote biasing

src/Tablebot/Plugins/Quote.hs

@@ -13,16 +13,18 @@
 -- 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, (==.))
+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)
@@ -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,
@@ -183,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"
 
@@ -196,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)
 
@@ -206,28 +212,45 @@ 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 []}
     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) => 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 = 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))
     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) => 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
+
 -- | @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.