{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module RoleSelfAssign ( reactionAddReceivers, reactionRemReceivers, receivers ) where
import Control.Monad ( guard
, unless
, forM_ )
import UnliftIO ( liftIO )
import Data.Aeson ( decode )
import Data.Bifunctor ( first
, bimap
)
import Data.Char ( isDigit )
import Data.Map ( Map
, toList )
import Data.Maybe ( fromJust
, isJust
, isNothing
)
import qualified Data.Text as T
import Data.Text.Encoding ( encodeUtf8 )
import Data.ByteString.Lazy ( fromStrict )
import Discord.Types
import Discord
import Command
import Owoifier ( owoify )
import Utils ( sendMessageDM
, newModCommand
, isEmojiValid
, isRoleInGuild
, sendMessageChan
, addReaction
)
import CSV ( readCSV
, readSingleColCSV
, addToCSV
, writeCSV
)
import TemplateRE ( accoladedArgRE
, quotedArgRE
, spaceRE
)
type EmojiRoleMap = [(String, RoleId)]
type RoleStation = [(String, EmojiRoleMap, String)]
reactionAddReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionAddReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionAddReceivers = [ ReactionInfo -> DiscordHandler ()
attemptRoleAssign ]
reactionRemReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionRemReceivers :: [ReactionInfo -> DiscordHandler ()]
reactionRemReceivers = [ ReactionInfo -> DiscordHandler ()
handleRoleRemove ]
receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers =
[ Message -> DiscordHandler ()
createAssignStation
, Message -> DiscordHandler ()
addRoleToStation
]
assignFilePath :: FilePath
assignFilePath :: FilePath
assignFilePath = FilePath
"idAssign.csv"
serverID :: GuildId
serverID :: GuildId
serverID = GuildId
755798054455738489
createAssignStationSyntax :: T.Text
createAssignStationSyntax :: Text
createAssignStationSyntax = Text
"Syntax: `:createSelfAssign \"<prependText>\" \"<appendText>\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"{\"emoji1\": \"roleText1\", \"emoji2\": \"roleText2\", ...}`"
addRoleToStationSyntax :: T.Text
addRoleToStationSyntax :: Text
addRoleToStationSyntax = Text
"Syntax: `:addRoleToStation \"<prependText>\" \"<appendText>\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\"<stationID>\" \"<channelID>\" \"<emoji>\" \"<roleText>\"`"
twoDimMatrixToMap :: Functor f => f [a] -> f (a, a)
twoDimMatrixToMap :: f [a] -> f (a, a)
twoDimMatrixToMap = ([a] -> (a, a)) -> f [a] -> f (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[a
x, a
y] -> (a
x, a
y))
mapToMatrix :: Functor f => f (a, a) -> f [a]
mapToMatrix :: f (a, a) -> f [a]
mapToMatrix = ((a, a) -> [a]) -> f (a, a) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
x, a
y) -> [a
x, a
y])
addRoleToStation :: Message -> DiscordHandler ()
addRoleToStation :: Message -> DiscordHandler ()
addRoleToStation Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
m (Text
"addRoleToStation" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE) (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do
let [Text
prependT, Text
appendT, Text
stationID, Text
channelID, Text
emoji, Text
role] = [Text]
captures
Bool
doesEmojiExist <- Text -> GuildId -> DiscordHandler Bool
isEmojiValid Text
emoji GuildId
serverID
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doesEmojiExist
(GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
Text
"The emoji provided is invalid. Perhaps you used one from another server?")
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doesEmojiExist
Maybe GuildId
roleIDM <- Text -> GuildId -> ReaderT DiscordHandle IO (Maybe GuildId)
forall (m :: * -> *).
MonadDiscord m =>
Text -> GuildId -> m (Maybe GuildId)
isRoleInGuild Text
role GuildId
serverID
let doesRoleExist :: Bool
doesRoleExist = Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
roleIDM
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doesRoleExist
(GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
Text
"The role provided is invalid. Please make sure you use the role's name!")
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doesRoleExist
let (FilePath
stationIDStr, FilePath
channelIDStr) = (Text -> FilePath
T.unpack Text
stationID, Text -> FilePath
T.unpack Text
channelID)
let (GuildId
stationIDNum, GuildId
channelIDNum) = (FilePath -> GuildId
forall a. Read a => FilePath -> a
read FilePath
stationIDStr, FilePath -> GuildId
forall a. Read a => FilePath -> a
read FilePath
channelIDStr)
let Just GuildId
roleID = Maybe GuildId
roleIDM
let assignFilePath :: FilePath
assignFilePath = FilePath -> FilePath
getAssignFile' FilePath
stationIDStr
[[Text]]
roleEmoteMatrix <- 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]]
readCSV FilePath
assignFilePath
let emojiRoleIDMap :: [(Text, GuildId)]
emojiRoleIDMap = (Text
emoji, GuildId
roleID) (Text, GuildId) -> [(Text, GuildId)] -> [(Text, GuildId)]
forall a. a -> [a] -> [a]
: ((Text, Text) -> (Text, GuildId))
-> [(Text, Text)] -> [(Text, GuildId)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> (Text -> FilePath) -> Text -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> GuildId) -> (Text, Text) -> (Text, GuildId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([[Text]] -> [(Text, Text)]
forall (f :: * -> *) a. Functor f => f [a] -> f (a, a)
twoDimMatrixToMap [[Text]]
roleEmoteMatrix)
Text
assignStationT <- Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
emojiRoleIDMap
Message
_ <- (GuildId, GuildId)
-> Text -> Maybe CreateEmbed -> ReaderT DiscordHandle IO Message
forall (m :: * -> *).
MonadDiscord m =>
(GuildId, GuildId) -> Text -> Maybe CreateEmbed -> m Message
editMessage (GuildId
channelIDNum, GuildId
stationIDNum) Text
assignStationT Maybe CreateEmbed
forall a. Maybe a
Nothing
()
_ <- IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ())
-> ([(Text, Text)] -> IO ()) -> [(Text, Text)] -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [[Text]] -> IO ()
writeCSV FilePath
assignFilePath ([[Text]] -> IO ())
-> ([(Text, Text)] -> [[Text]]) -> [(Text, Text)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> [[Text]]
forall (f :: * -> *) a. Functor f => f (a, a) -> f [a]
mapToMatrix ([(Text, Text)] -> DiscordHandler ())
-> [(Text, Text)] -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ (GuildId -> Text) -> (Text, GuildId) -> (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Text
T.pack (FilePath -> Text) -> (GuildId -> FilePath) -> GuildId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> FilePath
forall a. Show a => a -> FilePath
show) ((Text, GuildId) -> (Text, Text))
-> [(Text, GuildId)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap
GuildId -> GuildId -> Text -> DiscordHandler ()
addReaction GuildId
channelIDNum GuildId
stationIDNum Text
emoji
getAssignFile :: MessageId -> FilePath
getAssignFile :: GuildId -> FilePath
getAssignFile = FilePath -> FilePath
getAssignFile' (FilePath -> FilePath)
-> (GuildId -> FilePath) -> GuildId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> FilePath
forall a. Show a => a -> FilePath
show
getAssignFile' :: String -> FilePath
getAssignFile' :: FilePath -> FilePath
getAssignFile' FilePath
mid = FilePath
mid FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".selfAssign"
roleIdToRole :: RoleId -> [Role] -> T.Text
roleIdToRole :: GuildId -> [Role] -> Text
roleIdToRole GuildId
rid [Role]
roles = Role -> Text
roleName (Role -> Text) -> ([Role] -> Role) -> [Role] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Role] -> Role
forall a. [a] -> a
head ([Role] -> Text) -> [Role] -> Text
forall a b. (a -> b) -> a -> b
$ (Role -> Bool) -> [Role] -> [Role]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Role
r -> Role -> GuildId
roleId Role
r GuildId -> GuildId -> Bool
forall a. Eq a => a -> a -> Bool
== GuildId
rid) [Role]
roles
formatAssignStation :: T.Text -> T.Text -> [(T.Text, RoleId)] -> DiscordHandler T.Text
formatAssignStation :: Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
options = do
[Role]
roles <- GuildId -> ReaderT DiscordHandle IO [Role]
forall (m :: * -> *). MonadDiscord m => GuildId -> m [Role]
getGuildRoles GuildId
serverID
let roleTextOptions :: [(Text, Text)]
roleTextOptions = (\(Text
emojiT, GuildId
roleID) -> (Text
emojiT, GuildId -> [Role] -> Text
roleIdToRole GuildId
roleID [Role]
roles)) ((Text, GuildId) -> (Text, Text))
-> [(Text, GuildId)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
options
let optionsT :: [Text]
optionsT = (\(Text
emoji, Text
roleName) ->
Text
"`[`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
emoji Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`]` for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`[`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
roleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`]`")
((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
roleTextOptions
Text -> DiscordHandler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DiscordHandler Text) -> Text -> DiscordHandler Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
Text
prependT,
Text
"",
[Text] -> Text
T.unlines [Text]
optionsT,
Text
appendT
]
jsonTxtToMap :: T.Text -> Maybe (Map String String)
jsonTxtToMap :: Text -> Maybe (Map FilePath FilePath)
jsonTxtToMap = ByteString -> Maybe (Map FilePath FilePath)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Map FilePath FilePath))
-> (Text -> ByteString) -> Text -> Maybe (Map FilePath FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
createAssignStation :: Message -> DiscordHandler ()
createAssignStation :: Message -> DiscordHandler ()
createAssignStation Message
m = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
m (Text
"createSelfAssign" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedArgRE Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spaceRE
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
accoladedArgRE) (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do
let [Text
prependT, Text
appendT, Text
emojiRoleJson] = [Text]
captures
let emojiRoleMapM :: Maybe (Map FilePath FilePath)
emojiRoleMapM = Text -> Maybe (Map FilePath FilePath)
jsonTxtToMap Text
emojiRoleJson
case Maybe (Map FilePath FilePath)
emojiRoleMapM of
Maybe (Map FilePath FilePath)
Nothing -> do
GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$
Text
"Invalid JSON. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
createAssignStationSyntax
Just Map FilePath FilePath
emojiRoleMap' -> do
let emojiRoleMap :: [(Text, Text)]
emojiRoleMap = (FilePath -> Text)
-> (FilePath -> Text) -> (FilePath, FilePath) -> (Text, Text)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FilePath -> Text
T.pack FilePath -> Text
T.pack ((FilePath, FilePath) -> (Text, Text))
-> [(FilePath, FilePath)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
toList Map FilePath FilePath
emojiRoleMap'
Bool
doEmojisExist <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool)
-> ReaderT DiscordHandle IO [Bool] -> DiscordHandler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DiscordHandler Bool] -> ReaderT DiscordHandle IO [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((\(Text
emoji, Text
_) -> Text -> GuildId -> DiscordHandler Bool
isEmojiValid Text
emoji GuildId
serverID) ((Text, Text) -> DiscordHandler Bool)
-> [(Text, Text)] -> [DiscordHandler Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
emojiRoleMap)
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doEmojisExist
(GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
Text
"One of the emojis provided is invalid. Perhaps you used one from another server?")
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doEmojisExist
[(Text, Maybe GuildId)]
emojiRoleIDMMap <- [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
-> ReaderT DiscordHandle IO [(Text, Maybe GuildId)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ReaderT DiscordHandle IO (Text, Maybe GuildId)]
-> ReaderT DiscordHandle IO [(Text, Maybe GuildId)])
-> [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
-> ReaderT DiscordHandle IO [(Text, Maybe GuildId)]
forall a b. (a -> b) -> a -> b
$ (\(Text
emoji, Text
roleFragment) ->
(Text
emoji, ) (Maybe GuildId -> (Text, Maybe GuildId))
-> ReaderT DiscordHandle IO (Maybe GuildId)
-> ReaderT DiscordHandle IO (Text, Maybe GuildId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GuildId -> ReaderT DiscordHandle IO (Maybe GuildId)
forall (m :: * -> *).
MonadDiscord m =>
Text -> GuildId -> m (Maybe GuildId)
isRoleInGuild Text
roleFragment GuildId
serverID) ((Text, Text) -> ReaderT DiscordHandle IO (Text, Maybe GuildId))
-> [(Text, Text)]
-> [ReaderT DiscordHandle IO (Text, Maybe GuildId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
emojiRoleMap
let doRolesExist :: Bool
doRolesExist = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((Text, Maybe GuildId) -> Bool) -> [(Text, Maybe GuildId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Text
_, Maybe GuildId
roleIDM) -> Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GuildId
roleIDM) [(Text, Maybe GuildId)]
emojiRoleIDMMap
Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doRolesExist
(GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageChan (Message -> GuildId
messageChannel Message
m)
Text
"One of the roles provided is invalid. Please make sure you use the roles' names!")
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
doRolesExist
let emojiRoleIDMap :: [(Text, GuildId)]
emojiRoleIDMap = (\(Text
emoji, Just GuildId
roleID) -> (Text
emoji, GuildId
roleID)) ((Text, Maybe GuildId) -> (Text, GuildId))
-> [(Text, Maybe GuildId)] -> [(Text, GuildId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe GuildId)]
emojiRoleIDMMap
Text -> Text -> Message -> [(Text, GuildId)] -> DiscordHandler ()
handleRoleMapping Text
prependT Text
appendT Message
m [(Text, GuildId)]
emojiRoleIDMap
handleRoleMapping :: T.Text -> T.Text -> Message -> [(T.Text, RoleId)] -> DiscordHandler ()
handleRoleMapping :: Text -> Text -> Message -> [(Text, GuildId)] -> DiscordHandler ()
handleRoleMapping Text
prependT Text
appendT Message
m [(Text, GuildId)]
emojiRoleIDMap = do
Text
assignStationT <- Text -> Text -> [(Text, GuildId)] -> DiscordHandler Text
formatAssignStation Text
prependT Text
appendT [(Text, GuildId)]
emojiRoleIDMap
Message
newMessage <- GuildId -> Text -> ReaderT DiscordHandle IO Message
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> Text -> m Message
createMessage (Message -> GuildId
messageChannel Message
m) Text
assignStationT
let assignStationID :: GuildId
assignStationID = Message -> GuildId
messageId Message
newMessage
let newFileName :: FilePath
newFileName = GuildId -> FilePath
getAssignFile GuildId
assignStationID
()
_ <- IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ())
-> ([[Text]] -> IO ()) -> [[Text]] -> DiscordHandler ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [[Text]] -> IO ()
writeCSV FilePath
newFileName ([[Text]] -> DiscordHandler ()) -> [[Text]] -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ (\(Text
key, GuildId
value) -> [Text
key, FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ GuildId -> FilePath
forall a. Show a => a -> FilePath
show GuildId
value]) ((Text, GuildId) -> [Text]) -> [(Text, GuildId)] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap
let emojiList :: [Text]
emojiList = (Text, GuildId) -> Text
forall a b. (a, b) -> a
fst ((Text, GuildId) -> Text) -> [(Text, GuildId)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, GuildId)]
emojiRoleIDMap
[Text] -> (Text -> DiscordHandler ()) -> DiscordHandler ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
emojiList (GuildId -> GuildId -> Text -> DiscordHandler ()
addReaction (Message -> GuildId
messageChannel Message
newMessage) GuildId
assignStationID)
()
_ <- 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 ()
addToCSV FilePath
assignFilePath [[FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ GuildId -> FilePath
forall a. Show a => a -> FilePath
show GuildId
assignStationID, FilePath -> Text
T.pack FilePath
newFileName]]
() -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
isOnAssignMessage :: ReactionInfo -> DiscordHandler Bool
isOnAssignMessage :: ReactionInfo -> DiscordHandler Bool
isOnAssignMessage ReactionInfo
r = do
[GuildId]
validMessages <- IO [GuildId] -> ReaderT DiscordHandle IO [GuildId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [GuildId]
getAssignMessageIds
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
$ ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r GuildId -> [GuildId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GuildId]
validMessages
attemptRoleAssign :: ReactionInfo -> DiscordHandler ()
attemptRoleAssign :: ReactionInfo -> DiscordHandler ()
attemptRoleAssign ReactionInfo
r = do
Bool
validMsg <- ReactionInfo -> DiscordHandler Bool
isOnAssignMessage ReactionInfo
r
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
validMsg
Maybe Text
assFileName <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r
[(Text, GuildId)]
roleMap <- IO [(Text, GuildId)] -> ReaderT DiscordHandle IO [(Text, GuildId)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)])
-> IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ Text -> IO [(Text, GuildId)]
getRoleMap (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
assFileName)
let desiredRole :: Maybe GuildId
desiredRole = Text -> [(Text, GuildId)] -> Maybe GuildId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toUpper (Text -> Text) -> (Emoji -> Text) -> Emoji -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> Emoji
reactionEmoji ReactionInfo
r) [(Text, GuildId)]
roleMap
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> DiscordHandler ()) -> Bool -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
desiredRole
let newRoleId :: GuildId
newRoleId = Maybe GuildId -> GuildId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe GuildId
desiredRole
GuildId -> GuildId -> GuildId -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> GuildId -> GuildId -> m ()
addGuildMemberRole GuildId
serverID (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r) GuildId
newRoleId
GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageDM (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r)
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Added your desired role! Hurray!"
handleRoleRemove :: ReactionInfo -> DiscordHandler ()
handleRoleRemove :: ReactionInfo -> DiscordHandler ()
handleRoleRemove ReactionInfo
r = do
[GuildId]
validMessages <- IO [GuildId] -> ReaderT DiscordHandle IO [GuildId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [GuildId]
getAssignMessageIds
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r GuildId -> [GuildId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GuildId]
validMessages)
Maybe Text
assFileName <- IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text))
-> IO (Maybe Text) -> ReaderT DiscordHandle IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r
[(Text, GuildId)]
roleMap <- IO [(Text, GuildId)] -> ReaderT DiscordHandle IO [(Text, GuildId)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)])
-> IO [(Text, GuildId)]
-> ReaderT DiscordHandle IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ Text -> IO [(Text, GuildId)]
getRoleMap (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
assFileName)
let desiredRole :: Maybe GuildId
desiredRole = Text -> [(Text, GuildId)] -> Maybe GuildId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toUpper (Text -> Text) -> (Emoji -> Text) -> Emoji -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emoji -> Text
emojiName (Emoji -> Text) -> Emoji -> Text
forall a b. (a -> b) -> a -> b
$ ReactionInfo -> Emoji
reactionEmoji ReactionInfo
r) [(Text, GuildId)]
roleMap
Bool -> DiscordHandler ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> DiscordHandler ()) -> Bool -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Maybe GuildId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GuildId
desiredRole
let oldRoleId :: GuildId
oldRoleId = Maybe GuildId -> GuildId
forall a. HasCallStack => Maybe a -> a
fromJust Maybe GuildId
desiredRole
GuildId -> GuildId -> GuildId -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
GuildId -> GuildId -> GuildId -> m ()
removeGuildMemberRole GuildId
serverID (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r) GuildId
oldRoleId
GuildId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => GuildId -> Text -> m ()
sendMessageDM (ReactionInfo -> GuildId
reactionUserId ReactionInfo
r)
(Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Really sorry you didn't like the role, I went ahead and removed it."
getRoleMap :: T.Text -> IO [(T.Text, RoleId)]
getRoleMap :: Text -> IO [(Text, GuildId)]
getRoleMap Text
dir = do
[[Text]]
contents <- FilePath -> IO [[Text]]
readCSV (FilePath -> IO [[Text]]) -> FilePath -> IO [[Text]]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
dir
[(Text, GuildId)] -> IO [(Text, GuildId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, GuildId)] -> IO [(Text, GuildId)])
-> [(Text, GuildId)] -> IO [(Text, GuildId)]
forall a b. (a -> b) -> a -> b
$ do
[Text]
line <- [[Text]]
contents
(Text, GuildId) -> [(Text, GuildId)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Text
forall a. [a] -> a
head [Text]
line, (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> ([Text] -> FilePath) -> [Text] -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail) [Text]
line)
getRoleListIndex :: ReactionInfo -> IO (Maybe T.Text)
getRoleListIndex :: ReactionInfo -> IO (Maybe Text)
getRoleListIndex ReactionInfo
r = do
[[Text]]
contents <- FilePath -> IO [[Text]]
readCSV FilePath
assignFilePath
Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text))
-> ([(GuildId, Text)] -> Maybe Text)
-> [(GuildId, Text)]
-> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildId -> [(GuildId, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ReactionInfo -> GuildId
reactionMessageId ReactionInfo
r) ([(GuildId, Text)] -> IO (Maybe Text))
-> [(GuildId, Text)] -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
[Text]
line <- [[Text]]
contents
let pair :: (Text, Text)
pair = ([Text] -> Text
forall a. [a] -> a
head [Text]
line, ([Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail) [Text]
line)
(GuildId, Text) -> [(GuildId, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((GuildId, Text) -> [(GuildId, Text)])
-> (GuildId, Text) -> [(GuildId, Text)]
forall a b. (a -> b) -> a -> b
$ (Text -> GuildId) -> (Text, Text) -> (GuildId, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> (Text -> FilePath) -> Text -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (Text, Text)
pair
getAssignMessageIds :: IO [MessageId]
getAssignMessageIds :: IO [GuildId]
getAssignMessageIds = do
[[Text]]
lines <- FilePath -> IO [[Text]]
readCSV FilePath
assignFilePath
[GuildId] -> IO [GuildId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GuildId] -> IO [GuildId]) -> [GuildId] -> IO [GuildId]
forall a b. (a -> b) -> a -> b
$ ([Text] -> GuildId) -> [[Text]] -> [GuildId]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> GuildId
forall a. Read a => FilePath -> a
read (FilePath -> GuildId) -> ([Text] -> FilePath) -> [Text] -> GuildId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit (FilePath -> FilePath)
-> ([Text] -> FilePath) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> ([Text] -> Text) -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head) [[Text]]
lines