{-# 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" -- star
    ] -- These are matched case-insensitively

hallOfFameChannel :: ChannelId
hallOfFameChannel :: ChannelId
hallOfFameChannel = ChannelId
790936269382615082 --the channel id for the hall of fame

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 --gets contents of message that was reacted to.
    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)
    --adds the message id to the csv to make sure we dont add it multiple times.
    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