diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index a84da78..f337195 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/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.