{-# LANGUAGE OverloadedStrings #-}
module HallOfFame ( reactionReceivers, messageReceivers ) where
import Control.Monad ( when )
import qualified Data.Text as T
import Discord ( DiscordHandler
, RestCallErrorCode
)
import Discord.Types ( ChannelId
, Attachment ( attachmentUrl )
, Emoji ( emojiName )
, Message ( messageReactions
, messageId
, messageText
, messageChannel
, messageAttachments
, messageChannel
)
, MessageReaction ( messageReactionCount
, messageReactionEmoji
)
, CreateEmbed ( CreateEmbed )
, CreateEmbedImage ( CreateEmbedImageUrl )
, ReactionInfo ( reactionEmoji
, reactionChannelId
)
)
import Text.Read ( readMaybe )
import UnliftIO ( liftIO )
import Owoifier ( owoify )
import Utils ( sendMessageChan
, pingAuthorOf
, messageFromReaction
, linkChannel
, getMessageLink
, sendMessageChanEmbed
, getTimestampFromMessage
, newDevCommand
)
import CSV ( readSingleColCSV
, writeSingleColCSV
)
import DB ( fetch
, store
)
reactionReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionReceivers = [ ReactionInfo -> DiscordHandler ()
attemptHallOfFame ]
messageReceivers :: [Message -> DiscordHandler ()]
messageReceivers :: [Message -> DiscordHandler ()]
messageReceivers = [ Message -> DiscordHandler ()
reactLimit ]
attemptHallOfFame :: ReactionInfo -> DiscordHandler ()
attemptHallOfFame :: ReactionInfo -> DiscordHandler ()
attemptHallOfFame ReactionInfo
r =
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ReactionInfo -> Bool
isHallOfFameEmote ReactionInfo
r Bool -> Bool -> Bool
&& ReactionInfo -> Bool
notInHallOfFameChannel ReactionInfo
r) (DiscordHandler () -> DiscordHandler ())
-> DiscordHandler () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ do
Bool
eligible <- ReactionInfo -> DiscordHandler Bool
isEligibleForHallOfFame ReactionInfo
r
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eligible (DiscordHandler () -> DiscordHandler ())
-> DiscordHandler () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> DiscordHandler ()
putInHallOfFame ReactionInfo
r
hallOfFameEmotes :: [T.Text]
hallOfFameEmotes :: [Text]
hallOfFameEmotes = Text -> Text
T.toUpper (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[ Text
"XREE"
, Text
"KEKW"
, Text
"\11088"
]
hallOfFameChannel :: ChannelId
hallOfFameChannel :: ChannelId
hallOfFameChannel = ChannelId
790936269382615082
notInHallOfFameChannel :: ReactionInfo -> Bool
notInHallOfFameChannel :: ReactionInfo -> Bool
notInHallOfFameChannel ReactionInfo
r = ReactionInfo -> ChannelId
reactionChannelId ReactionInfo
r ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
/= ChannelId
hallOfFameChannel
isHallOfFameEmote :: ReactionInfo -> Bool
isHallOfFameEmote :: ReactionInfo -> Bool
isHallOfFameEmote ReactionInfo
r = Text -> Text
T.toUpper (Emoji -> Text
emojiName (ReactionInfo -> Emoji
reactionEmoji ReactionInfo
r)) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
hallOfFameEmotes
existsInHOF :: Message -> IO Bool
existsInHOF :: Message -> IO Bool
existsInHOF Message
m = do
[Text]
msgIdList <- IO [Text] -> IO [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [Text]
readSingleColCSV FilePath
"fame.csv"
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ChannelId -> FilePath
forall a. Show a => a -> FilePath
show (Message -> ChannelId
messageId Message
m) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> FilePath
T.unpack (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
msgIdList)
isEligibleForHallOfFame :: ReactionInfo -> DiscordHandler Bool
isEligibleForHallOfFame :: ReactionInfo -> DiscordHandler Bool
isEligibleForHallOfFame ReactionInfo
r = do
Message
mess <- ReactionInfo -> ReaderT DiscordHandle IO Message
forall (m :: * -> *). MonadDiscord m => ReactionInfo -> m Message
messageFromReaction ReactionInfo
r
Int
limit <- IO Int -> ReaderT DiscordHandle IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
readLimit
Bool
exists <- IO Bool -> DiscordHandler Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> DiscordHandler Bool) -> IO Bool -> DiscordHandler Bool
forall a b. (a -> b) -> a -> b
$ Message -> IO Bool
existsInHOF Message
mess
let reactions :: [MessageReaction]
reactions = Message -> [MessageReaction]
messageReactions Message
mess
let fulfillCond :: MessageReaction -> Bool
fulfillCond = \MessageReaction
x ->
Text -> Text
T.toUpper (Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ MessageReaction -> Emoji
messageReactionEmoji MessageReaction
x) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
hallOfFameEmotes
Bool -> Bool -> Bool
&& MessageReaction -> Int
messageReactionCount MessageReaction
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
exists
Bool -> DiscordHandler Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> DiscordHandler Bool) -> Bool -> DiscordHandler Bool
forall a b. (a -> b) -> a -> b
$ (MessageReaction -> Bool) -> [MessageReaction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MessageReaction -> Bool
fulfillCond [MessageReaction]
reactions
putInHallOfFame :: ReactionInfo -> DiscordHandler ()
putInHallOfFame :: ReactionInfo -> DiscordHandler ()
putInHallOfFame ReactionInfo
r = do
Message
mess <- ReactionInfo -> ReaderT DiscordHandle IO Message
forall (m :: * -> *). MonadDiscord m => ReactionInfo -> m Message
messageFromReaction ReactionInfo
r
CreateEmbed
embed <- Message -> DiscordHandler CreateEmbed
createHallOfFameEmbed Message
mess
[Text]
msgIdList <- IO [Text] -> ReaderT DiscordHandle IO [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> ReaderT DiscordHandle IO [Text])
-> IO [Text] -> ReaderT DiscordHandle IO [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [Text]
readSingleColCSV FilePath
"fame.csv"
IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> IO ()
writeSingleColCSV FilePath
"fame.csv" (FilePath -> Text
T.pack (ChannelId -> FilePath
forall a. Show a => a -> FilePath
show (ChannelId -> FilePath) -> ChannelId -> FilePath
forall a b. (a -> b) -> a -> b
$ Message -> ChannelId
messageId Message
mess)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
msgIdList)
ChannelId -> Text -> CreateEmbed -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> Text -> CreateEmbed -> m ()
sendMessageChanEmbed ChannelId
hallOfFameChannel Text
"" CreateEmbed
embed
createDescription :: Message -> T.Text
createDescription :: Message -> Text
createDescription Message
m = Message -> Text
messageText Message
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Message -> Text
pingAuthorOf Message
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChannelId -> Text
linkChannel (Message -> ChannelId
messageChannel Message
m)
getImageFromMessage :: Message -> T.Text
getImageFromMessage :: Message -> Text
getImageFromMessage Message
m
| Bool -> Bool
not (Bool -> Bool) -> ([Attachment] -> Bool) -> [Attachment] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attachment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Attachment] -> Bool) -> [Attachment] -> Bool
forall a b. (a -> b) -> a -> b
$ Message -> [Attachment]
messageAttachments Message
m = Attachment -> Text
attachmentUrl ([Attachment] -> Attachment
forall a. [a] -> a
head ([Attachment] -> Attachment) -> [Attachment] -> Attachment
forall a b. (a -> b) -> a -> b
$ Message -> [Attachment]
messageAttachments Message
m)
| Bool
otherwise = Text
""
createHallOfFameEmbed :: Message -> DiscordHandler CreateEmbed
createHallOfFameEmbed :: Message -> DiscordHandler CreateEmbed
createHallOfFameEmbed Message
m = do
Text
messLink <- Message -> DiscordHandler Text
getMessageLink Message
m
let authorName :: Text
authorName = Text
""
authorUrl :: Text
authorUrl = Text
""
authorIcon :: Maybe a
authorIcon = Maybe a
forall a. Maybe a
Nothing
embedTitle :: Text
embedTitle = Text
"👑 best of ouw buwwshit"
embedUrl :: Text
embedUrl = Text
""
embedThumbnail :: Maybe a
embedThumbnail = Maybe a
forall a. Maybe a
Nothing
embedDescription :: Text
embedDescription = Message -> Text
createDescription Message
m
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n[Original Message](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
messLink Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
embedFields :: [a]
embedFields = []
embedImage :: Maybe CreateEmbedImage
embedImage = CreateEmbedImage -> Maybe CreateEmbedImage
forall a. a -> Maybe a
Just (CreateEmbedImage -> Maybe CreateEmbedImage)
-> CreateEmbedImage -> Maybe CreateEmbedImage
forall a b. (a -> b) -> a -> b
$
Text -> CreateEmbedImage
CreateEmbedImageUrl (Text -> CreateEmbedImage) -> Text -> CreateEmbedImage
forall a b. (a -> b) -> a -> b
$ Message -> Text
getImageFromMessage Message
m
embedFooterText :: Text
embedFooterText = Message -> Text
getTimestampFromMessage Message
m
embedFooterIcon :: Maybe a
embedFooterIcon = Maybe a
forall a. Maybe a
Nothing
CreateEmbed -> DiscordHandler CreateEmbed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreateEmbed -> DiscordHandler CreateEmbed)
-> CreateEmbed -> DiscordHandler CreateEmbed
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe CreateEmbedImage
-> Text
-> Text
-> Maybe CreateEmbedImage
-> Text
-> [EmbedField]
-> Maybe CreateEmbedImage
-> Text
-> Maybe CreateEmbedImage
-> CreateEmbed
CreateEmbed Text
authorName
Text
authorUrl
Maybe CreateEmbedImage
forall a. Maybe a
authorIcon
Text
embedTitle
Text
embedUrl
Maybe CreateEmbedImage
forall a. Maybe a
embedThumbnail
Text
embedDescription
[EmbedField]
forall a. [a]
embedFields
Maybe CreateEmbedImage
embedImage
Text
embedFooterText
Maybe CreateEmbedImage
forall a. Maybe a
embedFooterIcon
reactLimit :: Message -> DiscordHandler ()
reactLimit :: Message -> DiscordHandler ()
reactLimit Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newDevCommand Message
m Text
"reactLimit *([0-9]{1,3})?" (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do
let parsed :: Maybe Int
parsed = FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
captures)
case Maybe Int
parsed of
Maybe Int
Nothing -> do
Int
i <- IO Int -> ReaderT DiscordHandle IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
readLimit
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m)
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Current limit is at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i)
Just Int
i -> do
IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
setLimit Int
i
ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"New Limit Set"
setLimit :: Int -> IO ()
setLimit :: Int -> IO ()
setLimit Int
i = FilePath -> [Text] -> IO ()
writeSingleColCSV FilePath
"reactLim.csv" [FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i]
readLimit :: IO Int
readLimit :: IO Int
readLimit = do
[Text]
contents <- FilePath -> IO [Text]
readSingleColCSV FilePath
"reactLim.csv"
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
contents
then FilePath -> [Text] -> IO ()
writeSingleColCSV FilePath
"reactLim.csv" [Text
"1"] IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
else Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall a. Read a => FilePath -> a
read (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
contents